Your Choice 3

home *** CD-ROM | disk | FTP | other *** search

/ Your Choice 3 / Your Choice Software Collection 3.iso / prgmming / qb_tips / qbtips_j.doc next >

Wrap

Text File | 1993-04-09 | 222KB | 5,896 lines

Name: QBTips_J.Doc Date: 6/93 Also See: QBTips_A through QBTips_I Purpose: To provide insights and source code to help BASIC programmers -- beginner through advanced. Load this into your word processor or editor. Then scan it for tidbits you think will be useful. Just "cut & paste" sections you like to separate files, then run the code. Source: Below you'll find messages captured from the FidoNet Quik_Bas echo. We captured CODE and significant tips, and eliminated chatter. Format: Varies, depending on the author, their programming style, and the question or topic. A form-feed (Chr$(12)) appears after most messages. This allows you to print this, and have each message (ie., each topic) start on a new page. Recommendation: None! Some of what you'll see below is brilliant. Some demonstrates very poor programming techniques. But all of it can prove useful if you have a need. NOTE 1: We have NOT tried all the code you see here, and some of it may not run as-is. You may have to do a little editing to coax it. One reason that code may not run is that messages sometimes get truncated or mangled in transmission. Another reason is that authors make mistakes (or typos). Again, we haven't tried running everything; but when you do, you'll probably quickly spot places that need editing. NOTE 2: There may be near-duplicate messages. The original author may have refined the code, or may have found errors in the original. If you see something that looks interesting, before you rely on the code, scan for the topic or author to see if a new set of code is below you -- more recent messages appear below. And note that the next message may be in a later package. NOTE 3: BEFORE running any code segment, scan through it and LOOK FOR code fragments which could be DISASTROUS! *** We often run un-tested code fragments from a *** *** RAM or floppy disk. And BEFORE running it we *** *** scan for "c:" or "d:" (or other hard drive) *** *** letters. And we also scan for .. (see below) *** For example, scan for "OUT " -- and if you find any verify that the code is OUTting the correct values to the correct ports. Typos, transmission errors or programmer mistakes could send the wrong values to the wrong ports. At best, nothing will happen. At worst, you might fry your monitor -- or worse. Also look for INTERRUPT (or INTERRUPTx). These functions are v-e-r-y useful for invoking low-level DOS or BIOS functions. But that low-level access also comes with some risks! Programmer or transmission errors, open drive doors, etc., can, at best, cause your PC to hang. At worst, you could corrupt the FAT of your hard disk. ========================================================================= Msg #: 8690 QUIKBAS Subboard From: EARL MONTGOMERY Sent: 03-27-93 19:40 To: ALL Rcvd: -NO- Re: HEX-BIN.DOC While refreshing my memory on Hexadecimal and Binary notations (and the use of the logical operators <AND> <OR>, I found that it helped to take notes. This is a compilation of those notes. Some phrasing is entirely my own. So if you find any mistakes (other than grammar, sentence structure, or spelling! <smile>) please inform me so I can correct my document file. This document should prove useful to the new programmers. A little info on Hexadecimal notation. Hexadecimal is a numbering system based on 16 elements. Digits are numbered 0 through F as follows: 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, A, B, C, D, E, F Representing the digits 0 through 15. Hexadecimal system uses powers of 16. For example: &H19 (hexadecimal) represents 25 decimal. Let's see why. Starting from the right the power is 1. Therefore 9 X 1 = 9 Moving left the next is power is 16. Therefore 1 X 16 = 16 And 9 + 16 = 25. Let's try another. This time &HFF (hexadecimal) Again starting from the right (F=15) 15 X 1= 15 Moving left 15 X 16 = 240. And 240 + 15 = 255 So far we have looked at single byte hex values. Let's look at a 16 bit hex value. Remember 8 bits to the byte? Now we look at two adjoining bytes, or sixteen bits. &H1902 (hexadecimal) represents 6402 decimal. Again starting from the right 2 X 1= 2 Moving left 0 X 16 = 0 Moving left again <16 X 16 =256> 9 X 256 = 2304 Moving left again <16 X 256 = 4096> 1 X 4096 = 4096 And 2 + 0 + 2304 + 4096 = 6402 In basic hex values are preceeded by &H. For example &HFF or &H1902 In basic hex values can be determined by the command PRINT &HFF or PRINT &H1902. Decimal to hex is accomplished by PRINT HEX$(255) or PRINT HEX$(1902). Now let's look at the individual bits within a byte. Remember there are 8 bits to the byte and reading from Right to Left they increase in power by the power of 2. Binary notation reflects set bits with a 1. Non set bits with a 0. Let's look at one. 1 0 0 0 1 0 0 1 (This byte represents 137) As with hex we start at the right. 1 X 1= 1 Moving left 2 X 0 = 0 Moving left again 4 X 0 = 0 Moving left again 8 X 1 = 8 Moving left again 16 X 0 = 0 Moving left again 32 X 0 = 0 Moving left again 64 X 0 = 0 Moving left again 128 X 1 = 128 And 1 + 0 + 0 + 8 + 0 + 0 + 0 + 128 = 137 Logical Operators <AND> <OR> When you AND two numbers the results are in a new third number. For example: a = 137 b = 105 c = a AND b 1 0 0 0 1 0 0 1 This represents A <137> 0 1 1 0 1 0 0 1 This represents B <105> 0 0 0 0 1 0 0 1 This represents C <9> What occurs when you AND two numbers is that the computer compares the bits within the first number against the bits in the second number. If the bits are the same then they will remain the same in the third number. If they are not the same then the equivalent bits will be 0 in the third number. "Logical OR What occurs when you OR two numbers is that the computer compares the bits within the first number against the bits in the second number. If the bits are the same they will remain the same in the third number. If they are not the same then the bits will be 1 in the third number. For example: A=122 B=15 C=A OR B 0 1 1 1 1 0 1 0 This represents A <122> 0 0 0 0 1 1 1 1 This represents B <15> 0 1 1 1 1 1 1 1 This represents C <127> This quick little reference document composed by Earl Montgomery I hope it proves to be of some use to you. ' From: CHARLES GRAHAM Sent: 03-28-93 15:08 To: ALL Rcvd: -NO- Re: 1 OF 6 AMORTIZE.BAS 'Begin AMORTIZE.BAS Message 01 ' 'AMORTIZE.BAS -- CHARLES GRAHAM, POB 58634, ST.LOUIS, MO 63158 totint# = 0 pg = 0 totprin# = 0 yrct = 0 COLOR 10, 1 GOSUB logo LOCATE 1, 1 LINE INPUT ; "Enter client name(s) [40 char max] ====> "; client$ validated$ = "off" loball = 1 hiball# = 9999999.99# decimals = 1 WHILE validated$ = "off" GOSUB logo LOCATE 1, 1 LINE INPUT ; "Enter amount to be financed ====> "; amt$ quan$ = amt$ GOSUB validate WEND amt# = VAL(amt$) prinbal# = amt# validated$ = "off" loball = 1 hiball# = 25 decimals = 1 WHILE validated$ = "off" GOSUB logo LOCATE 1, 1 LINE INPUT ; "Enter APR [1-25] ====> "; rate$ quan$ = rate$ GOSUB validate WEND rate = VAL(rate$) i = rate / 1200 validated$ = "off" loball = 1 hiball# = 480 decimals = 0 WHILE validated$ = "off" GOSUB logo LOCATE 1, 1 LINE INPUT ; "Enter term of loan [1-480 months] ====> "; n$ quan$ = n$ GOSUB validate WEND n = VAL(n$) pmt# = amt# / ((1 - ((1 + i) ^ (-n))) / i) pmt# = INT((pmt# * 100) + .5) / 100 validated$ = "off" loball = 1 hiball# = 12 decimals = 0 WHILE validated$ = "off" GOSUB logo LOCATE 1, 1 LINE INPUT ; "Enter month first payment is due [1-12] ====> "; mo$ quan$ = mo$ GOSUB validate WEND mo = VAL(mo$) validated$ = "off" loball = 0 hiball# = 99 decimals = 0 WHILE validated$ = "off" GOSUB logo LOCATE 1, 1 LINE INPUT ; "Enter year first payment is due [00-99] ====> "; yr$ quan$ = yr$ GOSUB validate WEND yr = VAL(yr$) GOSUB logo LOCATE 1, 1 PRINT "Send output to screen or printer [s/p] ====> "; o$ = "" WHILE o$ <> "s" AND o$ <> "p" o$ = INKEY$ IF o$ = "S" THEN o$ = "s" ELSE IF o$ = "P" THEN o$ = "p" END IF END IF WEND PRINT o$ GOSUB logo LOCATE 1, 1 IF o$ = "p" THEN LOCATE 13, 29 PRINT "AMORTIZE is printing ... "; END IF GOSUB printheaders FOR ct = 1 TO n intr# = INT((i * prinbal# * 100) + .5) / 100 prin# = pmt# - intr# IF mo >= 13 THEN IF o$ = "s" THEN GOSUB pause FOR x = 9 TO 20 LOCATE x, 1 PRINT " "; NEXT x END IF mo = 1 yr = yr + 1 IF yr > 99 THEN yr = 0 END IF END IF totint# = totint# + intr# totprin# = totprin# + prin# prinbal# = amt# - totprin# IF mo = 1 THEN IF o$ = "s" THEN LOCATE 9, 1 ELSE IF ct <> 1 THEN LPRINT yrct = yrct + 1 IF yrct / 4 = INT(yrct / 4) THEN GOSUB printheaders END IF END IF END IF END IF IF o$ = "s" THEN PRINT USING "###"; ct; PRINT TAB(5); " "; PRINT USING "##"; mo; PRINT "/"; IF yr > 9 THEN PRINT USING "##"; yr; ELSE PRINT "0" + RIGHT$(STR$(yr), 1); END IF PRINT TAB(12); " "; PRINT USING "#######.##"; intr#; PRINT TAB(26); " "; PRINT USING "#######.##"; prin#; PRINT TAB(40); " "; PRINT USING "#######.##"; totint#; PRINT TAB(54); " "; PRINT USING "#######.##"; totprin#; PRINT TAB(68); " "; PRINT USING "#######.##"; prinbal# ELSE LPRINT USING "###"; ct; LPRINT TAB(5); " "; LPRINT USING "##"; mo; LPRINT "/"; IF yr > 9 THEN LPRINT USING "##"; yr; ELSE LPRINT "0" + RIGHT$(STR$(yr), 1); END IF LPRINT TAB(12); " "; LPRINT USING "#######.##"; intr#; LPRINT TAB(26); " "; LPRINT USING "#######.##"; prin#; LPRINT TAB(40); " "; LPRINT USING "#######.##"; totint#; LPRINT TAB(54); " "; LPRINT USING "#######.##"; totprin#; LPRINT TAB(68); " "; LPRINT USING "#######.##"; prinbal# END IF mo = mo + 1 NEXT ct IF o$ = "s" THEN GOSUB pause ELSE LPRINT CHR$(12); LPRINT CHR$(12); END IF COLOR 7, 0 CLS END ' ** Replace this with a blank line ** printheaders: IF o$ = "s" THEN PRINT client$ PRINT "Amount of loan = "; PRINT USING "#######.##"; amt# PRINT "Monthly payment = "; PRINT USING "#######.##"; pmt# PRINT "Annual Percentage Rate = "; PRINT USING "#####.####"; rate PRINT "Term of loan [months] = "; PRINT USING "###"; n PRINT PRINT "PMT DATE INT PAID PRIN PAID TOT INT " + _ "PAID TOT PRIN PD PRINCIPL BAL" LOCATE 22, 19 PRINT "Press ESCape to end, other key to continue"; LOCATE 9, 1 ELSE pg = pg + 1 LPRINT CHR$(12); LPRINT client$; LPRINT TAB(71); "Page"; pg LPRINT "Amount of loan = "; LPRINT USING "#######.##"; amt# LPRINT "Monthly payment = "; LPRINT USING "#######.##"; pmt# LPRINT "Annual Percentage Rate = "; LPRINT USING "#####.####"; rate LPRINT "Term of loan [months] = "; LPRINT USING "###"; n LPRINT LPRINT "PMT DATE INT PAID PRIN PAID TOT INT PAID TOT PRIN PD PRINCIPL BAL" LPRINT END IF RETURN ' ** Replace this with a blank line ** validate: errct = 0 decpts = 0 FOR x = 1 TO LEN(quan$) IF (MID$(quan$, x, 1) < "0" AND MID$(quan$, x, 1) <> ".") OR MID$(quan$, x, 1) > "9" THEN errct = errct + 1 END IF IF MID$(quan$, x, 1) = "." THEN decpts = decpts + 1 END IF NEXT x IF decpts > decimals THEN errct = errct + 1 END IF IF errct = 0 THEN IF VAL(quan$) < loball OR VAL(quan$) > hiball# THEN errct = errct + 1 END IF END IF IF errct = 0 THEN validated$ = "on" END IF RETURN ' ** Replace this with a blank line ** pause: a$ = "" WHILE a$ = "" a$ = INKEY$ WEND IF a$ = CHR$(27) THEN COLOR 7, 0 CLS END END IF RETURN ' ** Replace this with a blank line ** logo: CLS LOCATE 24, 17 PRINT ". AMORTIZE.BAS . For non-commercial use only ."; LOCATE 25, 17 PRINT "Charles Graham, POB 58634, St. Louis, MO 63158"; RETURN ' Msg #: 8929 QUIKBAS Subboard From: HANK TASSIN Sent: 03-28-93 12:15 To: TOM COAKLEY Rcvd: -NO- Re: ARROW KEYS At the beginning of Time, you scribbled to All: TC> On the new keyboards you have 2 sets of arrow keys. The one on the TC> numeric keypad and then one by itself. I can not figure out how to get TC> my Quick Basic 4.5 programs to accept input from the ones NOT on the TC> numeric keypad. This ticks me off to no end. If ANYONE knows how to do TC> this I would be forever gratefull for some E-Mail explaining how it is TC> done. Hiya Tom, Here is a piece of code I used to do that, although it could probably be made alot cleaner but appending CHR$(0) to the INKEY$ routine instead of grabbing RIGHT$ like I am doing, but it should get you started. BTW, it even recognizes the NumLock key and stops "moving" when a number is pressed from the keypad. CONST ENTER% = 13 CONST ESC% = 27 CONST RIGHT% = 28 CONST LEFT% = 29 CONST UP% = 30 CONST DOWN% = 31 CONST SPACEHIT% = 32 CONST GOHOME% = 71 CONST GREYUP% = 72 CONST GOPAGEUP% = 73 CONST GREYMINUS% = 74 CONST GREYLEFT% = 75 CONST GOCENTER% = 76 CONST GREYRIGHT% = 77 CONST GREYPLUS% = 78 CONST GOENDKEY% = 79 CONST GREYDOWN% = 80 CONST GOPAGEDOWN% = 81 FINISHED% = 0 DO WHILE FINISHED% < 1 DO TEMP$ = INKEY$ LOOP WHILE TEMP$ = "" MOVE% = ASC(RIGHT$(TEMP$, 1)) SELECT CASE MOVE% CASE ENTER% CALL SPACEOUT CASE etc..... END CASE ' **************************************************************** * The QUIK_BAS List of Frequently Asked Questions with * Some Simple Public Domain Solutions **************************************************************** TABLE OF CONTENTS: q1.0 The BASICS of BASIC s1.0 QUIKSORT.BAS -- recursive quicksort SUB q2.0 Commonly Requested Routines s2.0 HUTHSORT.BAS -- iterative quicksort SUB s3.0 BISEARCH.BAS -- binary search FUNCTION q3.0 Advanced Topics -- "Hashing in QuickBASIC" t1.0 Hashing Collision Table s4.0 FSTPRIME.BAS -- generates 4K+3 prime number t2.0 List Management System Ratings s5.0 WORDHASH.BAS -- word distribution counter q4.0 Structured BASIC Techniques NOTE: All source remains the property of those who originally wrote it, as understood by Canadian, American, and International Treaty. The text portion of this file itself is hereby released into the "Public Domain" for the purposes of education and enlightenment. Q1.0 The BASICS of BASIC: Q1.4 Okay, I've figured out FUNCTIONs and SUBs, and have even started using them with some kind of skill. Now, thing is, I come up to this thing called 'recursion.' What's this all about, and can you show me some practical application of it? A1.4 There is an old joke about the cryptic nature of dictionaries that goes something like this: re'CUR'sion (noun) 1. see recursion Actually, that's a pretty sad joke. One computer scientist's definition states: "... a recursive algorithm is one that contains a copy of itself within one of its instructions. Thus, a recursive algorithm is reminiscent of a set of mirrors in which you can see yourself looking at yourself looking at yourself." [J. Glenn Brookshear] Recursion is a powerful programming tool, and any comprehensive programming language allows it. QuickBASIC and its dialects are no exception. A simple example of recursion: SUB recurse recurse END SUB This thing will go in circles until the stack is full, crashing the program should it ever be called. It illustrates two of the main pitfalls of recursion: 1. recursion in QuickBASIC eats the stack for breakfast 2. there must be a terminating condition to exit the loop Since each call to a SUB or FUNCTION does some pushing to the stack, it must always be remembered that recursive routines will require a bit of the stack for every instance they are called. It is sometimes hard to know in advance how many times a recursive routine will end up calling itself, and therefore, one cannot know with any accuracy how much a given recursive routine will decide to rob from the stack. Be warned! This also leads to the next issue: there must ALWAYS be a terminating condition to exit the loop. Sometimes it is easy to overlook this point. Consider the above simple example. It never stops calling itself, does it? Were a theoretical computer to exist that had a theoretically infinitely large stack that could never be consumed by even the deepest level of recursion, what happens if that routine goes off into a corner and keeps calling itself? It results in a permanent time out known as a crash. (The moral of this? A bug on a i486 system is still a bug, just a bug that happens sooner.) An example of a terminating condition added to the above code: SUB recurse(n%) n% = n% + 1 IF n% < 10 THEN recurse END IF END SUB This SUB will call itself only until n% is equal to ten, at which point, it will reach its terminating state, and be finished on its job. This is a simple example, I admit, but NEVER forget to include a terminating statement in your recursive routines, or you will pay for it with a crash. Now that we have that out of the way, let's kill two birds with one stone. (It could be argued, in fact that the act of killing two birds with only one stone probably involves recursion somewhere in the solution.) Everyone wants to know a good QuickSort algorithm, and most implementations of that use recursion. So, a modified version of the QuickSort SUB from Microsoft, one that sorts an array passed to it: S1.0 QUIKSORT.BAS [F210S01.BAS] DEFINT A-Z SUB QuickSortSTR (Array() AS STRING, Low, High) ' /^\ /^\ ' | | ' Change these to any BASIC data type for this routine to ' handle other types of data arrays other than strings. ' '============================== QuickSortXXX ================================ ' QuickSortXXX works by picking a random "pivot" element in Array(), then ' moving every element that is bigger to one side of the pivot, and every ' element that is smaller to the other side. QuickSortXXX is then called ' recursively with the two subdivisions created by the pivot. Once the ' number of elements in a subdivision reaches two, the recursive calls end ' and the array is sorted. '=========================================================================== ' ' Microsoft's source code modified as needed ' STATIC BeenHere IF NOT BeenHere THEN Low = LBOUND(Array) High = UBOUND(Array) BeenHere = -1 END IF DIM Partition AS STRING ' Change STRING to any BASIC data type ' for this QuickSort routine to work with ' things other than strings. IF Low < High THEN ' Only two elements in this subdivision; swap them if they are out ' of order, then end recursive calls: IF High - Low = 1 THEN ' we have reached the terminating condition! IF Array(Low) > Array(High) THEN SWAP Low, High BeenHere = 0 END IF ELSE ' Pick a pivot element at random, then move it to the end: RandIndex = INT(RND * (High - Low + 1)) + Low SWAP Array(High), Array(RandIndex) Partition = Array(High) DO ' Move in from both sides towards the pivot element: I = Low: J = High DO WHILE (I < J) AND (Array(I) <= Partition) I = I + 1 LOOP DO WHILE (J > I) AND (Array(J) >= Partition) J = J - 1 LOOP ' If we haven't reached the pivot element, it means that two ' elements on either side are out of order, so swap them: IF I < J THEN SWAP Array(I), Array(J) END IF LOOP WHILE I < J ' Move the pivot element back to its proper place in the array: SWAP Array(I), Array(High) ' Recursively call the QuickSortSTR procedure (pass the smaller ' subdivision first to use less stack space): IF (I - Low) < (High - I) THEN QuickSortSTR Array(), Low, I - 1 QuickSortSTR Array(), I + 1, High ELSE QuickSortSTR Array(), I + 1, High QuickSortSTR Array(), Low, I - 1 END IF END IF END IF END SUB '=======>8 SAMPLE 1.0 ENDS HERE 8<========= Q1.5 So that's how to use recursion! That's great! I think I'm starting to get a hang of things with QuickBASIC now, thanks. But, how is it possible for it to call itself over and over like that without all those variables interfering with each other? I mean, I'm kind of used to GW-BASIC, and well, I just can't figure out why all those High and Low variables don't just write over one another. My docs say something about local and global scope, but it's all kind of confusing. What's the real difference between local, STATIC, COMMON, SHARED, COMMON SHARED, and all other flavors of variables? A1.5 Beginners with QuickBASIC sometimes have a hard time decrypting all of the different types of variable scope. Microsoft hasn't really helped anything with all the funny names for variable scope. GLOBAL would have made more sense than SHARED for most. Okay, let's look at how the QuickBASIC program is inevitably structured: 1. First, there is the 'module' level. That is the main part of the QuickBASIC program, the part where execution starts, and most programmers declare their constants, and put their main documentation. 2. Second, there is the SUB and FUNCTION level. Each SUB and FUNCTION could be thought of as a miniprogram unto itself. That's why SUBs are called that: subprogram. 3. Third, if you write bigger programs, you may actually have two or more modules, each one having its own SUBs and FUNCTIONs. Okay, then, any variable used at the modular level, or level 1, is accessible, or in the 'scope' of the modular level. If there is a variable called Foo at the modular level, with a value of 7, then any Foo at the SUB or FUNCTION level could also be called Foo, without interfering with the modular Foo. Think of each module level variable and each SUB and FUNCTION variable as being on different continents. They can have the same name with no problem. But, suppose you want a SUB or FUNCTION to have access to the Foo that was declared at the modular level. This is where the SHARED declarator comes in. In the SUB somesubprog, to have access to the Foo that was declared at the modular level, just add the declaration: SHARED Foo Any SUB or FUNCTION that doesn't want to have access to the modular Foo doesn't have to declare it as SHARED. This is a powerful feature, once you get the hang of it and feel confident enough to use it wisely. Now, suppose that you want a number of your SUBs or FUNCTIONs to have access to a common group of variables. At the modular level, the declaration would be: DIM SHARED Foo This would give ALL of the SUBs and FUNCTIONs of a given module access to the variable Foo. Any access of Foo at any level will alter the global variable. Now, suppose you have a multimodule program that has FIRST.BAS and SECOND.BAS linked together. Suppose you want them to communicate with one another via a common global variable. This is where COMMON SHARED comes in. Now that we've covered this, there is the issue of the STATIC declarator. Normally, variables at the SUB and FUNCTION level are dynamic, which means they disappear when the routine returns to the place that it was called from. By declaring a variable STATIC, we can be assured that whatever the variable's value was when we left, it will be when we return. To declare only a few of the variables as STATIC, use the form: SUB FooSub () STATIC Variable1, Variable2, etc. : : END SUB But, if you want ALL the variables to be STATIC, use the following method: SUB FooSub () STATIC : : : END SUB There are certain speed advantages to STATIC SUBs and FUNCTIONs, since variables are not created on the stack, but that is a more advanced issue. So, in summary: 1. SHARED allows SUBs and FUNCTIONs to use modular variables, 2. COMMON allows modules to share variables between themselves, 3. STATIC allows variables to retain their value between calls to the SUB or FUNCTION in question. Q2.0 Commonly Requested Routines: Q2.4 Okay, I've looked the whole thing over and I've realized something: the recursive QuickSortXXX routine eats the stack up pretty fast. Is there another way? Is there a way to implement a QuickSort SUB without using recursion? A2.4 Yes, indeed there is. Cornel Huth implemented an iterative quicksort algorithm, which I then tweaked a bit. It is actually a bit faster than the other, and doesn't use too much of the stack. It accomplishes this by using an array to simulate a stack. The modified version follows: S2.0 HUTHSORT.BAS [P210S02.BAS] ' HUTHSORT.BAS written by Cornel Huth ' Iterative QuickSort Routine ' SUB subHuthSortSTR (Array() AS STRING) ' ^ TWEAK THESE ^ ' | FOR OTHER TYPES | ' `--+--------------' ' V DIM compare AS STRING TYPE StackType low AS INTEGER hi AS INTEGER END TYPE DIM aStack(1 TO 128) AS StackType StackPtr = 1 aStack(StackPtr).low = LBOUND(Array) aStack(StackPtr).hi = UBOUND(Array) StackPtr = StackPtr + 1 DO StackPtr = StackPtr - 1 low = aStack(StackPtr).low hi = aStack(StackPtr).hi DO i = low j = hi mid = (low + hi) \ 2 compare = Array(mid) DO DO WHILE Array(i) < compare i = i + 1 LOOP DO WHILE Array(j) > compare j = j - 1 LOOP IF i <= j THEN SWAP Array(i), Array(j) i = i + 1 j = j - 1 END IF LOOP WHILE i <= j IF j - low < hi - i THEN IF i < hi THEN aStack(StackPtr).low = i aStack(StackPtr).hi = hi StackPtr = StackPtr + 1 END IF hi = j ELSE IF low < j THEN aStack(StackPtr).low = low aStack(StackPtr).hi = j StackPtr = StackPtr + 1 END IF low = i END IF LOOP WHILE low < hi 'IF StackPtr > maxsp THEN maxsp = StackPtr LOOP WHILE StackPtr <> 1 END SUB =======>8 SAMPLE 2.0 ENDS HERE 8<========= Q2.5 Now that I've got so many neat ways to sort a list, I'd sure like to be able to locate an entry in it quickly. I hear that a binary search is fast, but I just can't figure out how to do that. How do I do a binary search? A2.5 Binary searches are the fastest overall search method for standard sorted lists. Such lists can be divided in two, looked at, and divided again as necessary. A good search method is demonstrated here: S3.0 BISEARCH.BAS [F210S03.BAS] DEFINT A-Z FUNCTION BiSearchSTR (Find AS STRING, Array() AS STRING) Min = LBOUND(Array) 'start at first element Max = UBOUND(Array) 'consider through last DO Try = (Max + Min) \ 2 'start testing in middle IF Array(Try) = Find THEN 'found it! BiSearch = Try 'return matching element EXIT DO 'all done END IF IF Array(Try) > Find THEN 'too high, cut in half Max = Try - 1 ELSE Min = Try + 1 'too low, cut other way END IF LOOP WHILE Max >= Min END FUNCTION =======>8 SAMPLE 3.0 ENDS HERE 8<========= Q3.0 Advanced Topics -- "Hashing in QuickBASIC" Q3.1 That's pretty fast! I was so used to doing a sequential search on an unsorted list. Now that I have the QuickSort and the BiSearch routines, I can use them as a pair for faster list searches. The thing is, as soon as I want to add something to the list, it puts everything out of order by only one entry, and that hardly seems worth sorting all over again, even with something as fast as Cornel Huth's iterative QuickSort algorithm. Are there any alternatives to this way of doing things? I've heard talk of something called 'hashing' but I don't have any idea of what that is all about. How would I use hashing to avoid having to either resort the list, or use a slow insertion algorithm? Insertion is horrendously slow with disk files. A3.1 Hashing is a very efficient method of record access, be it in RAM or be it with a disk file. Basically, hashed arrays or data files can be quickly searched for a given item by a key index. Whenever you have to add an item to the list, you can at lightening speed, and since hashing "sorts" the array on-the-fly, as it were, there is no need to push records around to add new items to a hashed record. The first concept you must understand with hashing is the key index. Every data structure you design with hashing in mind has to have one field that is unique. This is a prerequisite that you just can't get around. Of course, you could actually combine several fields to generate this unique key, which effectively serves the same purpose. A good application of this is a Fidonet nodelist that uses the node address as the hashing key. No two alike in theory. But just how does this key work? First of all, let's take a look at the Fidonet example. Every full Fidonet address is unique to one node. Assume that the full nodelist has about 15000 entries. Okay, if you want a hashing table to hold 15000 unique entries, then research has shown that the table should be at least 30% greater than the number of entries in it. That would make 19500 table entries. This means that 4500 entries in the list will be left empty for best hashing results. Now, another problem comes up. How does the key come into play? Well, let's look at a simple key: 1153999. Since the list is 19500 long, we certainly can't just put this in record 1153999. Hashing involves dividing the key by the table size and taking the remainder and using that as the record number: 59 ---------- R 3499 19500) 1153999 Okay, 3499 is the record number in which we would put the data. This is the basic idea behind hashing. There is a trouble, however. Collision occurs whenever a node address, when divided by 19500 has a remainder of 3499. That 'bucket' is already full! So, what to do? Generate another bucket number, see if that bucket is full, and if it is, keep generating new buckets until we find an empty bucket. To find an item in a hashed table, we get its key, divide by the table size, and look at the bucket that is represented by the remainder. If that isn't the one, we generate the next bucket address, until we arrive at an empty bucket. If we encounter the correct key BEFORE we arrive at an empty bucket, then we've found our entry. If we arrive at an empty bucket, the record is not in the table. And there you have hashing. A well designed hashing table will yield this number of collisions per insertion or search: T1.0 Hashing Collision Table TABLE FULLNESS COLLISIONS ================================== 50% 2.0 60% 2.5 70% 3.3 90% 10.0 =======>8 TABLE 1.0 ENDS HERE 8<========= That shows better results than even the binary search, with large lists! Research has shown that the most efficient hashing tables, that is, the ones with the least number of collisions, have a prime number of entries. A table size of 1019 should produce less collisions than one of 1000. Research has also shown that if the prime is of the form 4K+3, where K is any positive integer, then collisions are reduced even further. 1019 also meets this second requirement. But, since a table size twice the size of the maximum number of entries it will ever hold is inefficient, the 4K+3 criterion should be abandoned at a certain point in favor of any prime number. Since most of us aren't idiot savants who can just come up with that number to suit our needs, here is a FUNCTION, written by Charles Graham, that accepts the maximum number of entries a table will have, and returns the proper type of prime number, to be used as a hashing table size: S4.0 FSTPRIME.BAS [F210S04.BAS] DEFINT A-Z ' This FUNCTION returns a prime number that is at least 30% greater than ' threshold. It will TRY to return a prime number that also fits into the ' form 4K+3, where k is any integer, but if the prime number is twice the ' size of the threshold, it will ignore this criterion. ' ' Written by Charles Graham ' FUNCTION funFirstPrime (threshold) CONST TRUE = -1 CONST FALSE = NOT TRUE tp30 = INT((threshold * 1.3) + .5) IF tp30 / 2 = tp30 \ 2 THEN tp30 = tp30 + 1 END IF c = tp30 - 2 IF c < 1 THEN c = 1 END IF t2 = threshold * 2 DO c = c + 2 FOR z = 3 TO SQR(c) ind = TRUE IF c / z = c \ z THEN ind = FALSE EXIT FOR END IF NEXT z IF ind THEN IF (c - 3) / 4 = INT((c - 3) / 4) OR c > t2 THEN funFirstPrime = c EXIT DO END IF END IF LOOP END FUNCTION =======>8 SAMPLE 4.0 ENDS HERE 8<========= Q3.1 How do I know when to use sequential searches, when to use binary searches, and when to use hashing? Are there any sort of guidelines? A3.1 Well, first let's consider where hashing is in its prime. (You'll pardon that one, okay?) It is best suited to dynamic list generation where items need to be added on a regular basis, but not deleted, since deletion is fairly difficult to implement on a hashed list. The main strength of a hashing system is its ability to quickly insert new items into the table in such a manner that they can be located quickly "on-the-fly." (See T1.0 for the average number of collisions before locating the correct entry.) Since the collisions increase with the ratio of full buckets to empty buckets, and not with the size of the actual table involved, hashing is more efficient than even binary searches when lists start to become huge. Also, because the binary method of searching demands a sorted list, insertion of items at a later time becomes very cumbersome, even with such techniques as the QuickSort and pushing all entries after the insertion up by one. (Try that technique on a list of 30,000 items, when you only want to add two new items that land near the beginning of the list, and you'll know what disk wear and tear is all about!) Typical applications of the hashing algorithm involve word distribution counts, dictionary table generators that involve dictionaries that will be added to dynamically, and things of that nature. Consider the word distribution count problem. Each word is a unique key, and so is perfect for hashing. Sequential methods only work well up until the table has so many entries in it that looking up entries in the table becomes a real effort. Remember, words already in the list do not need to be added twice. Binary methods allow for quick searching, but each case of a new word being added to the list requires a sort or cumbersome insertion. This takes time, if a text file is of even average length. Hashing, on the other hand, can increment the count of words already in the list, or add new words to the list, without the overhead of sorting, sequential searches, or push-type insertion. Also, remember that entry deletion is a problem with hashing. Word distribution counts NEVER require entries to be struck, and so are well-suited to hashing systems. A good rule of thumb to determine which method may be best for a given problem is to cosider the points on this table: T2.0 List Management System Ratings List Type SEQUENTIAL BINARY HASHED ===================================================== small list 1 3 2 medium list 3 1 2 large list 3 2 1 huge list 3 2 1 Insertion 2 3 1 Modification 3 2 1 Deletion 1 2 3 Browsing 2 1 3 (Systems are ranked first, second, or third) =======>8 TABLE 2.0 ENDS HERE 8<========= Using this table, we can see that the best method for short lists that require frequent deletions might be the sequential list. The best for huge lists that require insertions, modifications, but not deletions (such as a nodelist index) is probably a hashed list. A hashed list, however, will not do much for you if you regularly want to access the next item, first item in the list, or last item, such as in a list browsing system. Hashed lists have no logical beginning or end, and for this reason, there is no such thing as a "first item" or "next item" in a hashed list. Each entry is a single entity, retrievable only as a single entity, with no relation to any other entry in the hashed list. This excludes applications that require browsing, as I have mentioned, but is perfect for symbol tables, dictionaries, and the like. Q3.2 This is all pretty new to me. Give me a practical review. A3.2 Okay. In the hashed list there is no sense of sequence in the classic sense of the concept. Items are put into buckets based upon the type of calculation I have already discussed, and if the bucket is already in use, a new bucket is found according to a set system. Therefore, two similar items in a hashed table may actually have a physical distance of 500 entries between them. A practical example: We have a hash table 7 buckets big, and you want to store three entries in it, using hashing. For simplicity, let's just store the characters A, B, and C, using their ASCII values as keys. Their buckets would be: Item Formula Bucket ========================= A 65 MOD 7 2 B 66 MOD 7 3 C 67 MOD 7 4 No collisions have occured here, since this is a simple case. Now, let us add just one more item: H. The first bucket that H will request is 72 MOD 2, or 2, which is being used by A. This is collision. Now, we must find an empty bucket, and so, we apply a common method to the old bucket: we subtract an offset from 2. The offset is calulated thus: Offset = TableSize - Bucket, or Offset = 7 -2 Offset = 5 Okay, now, whenever a collision occurs, we recalculate a position using this formula: NewPos = OldPos - Offset NewPos = 2 - 5 NewPos = -3 In cases where NewPos is less than 0, we then add the table size to the interim result: NewPos = NewPos + TableSize, or NewPos = -3 + 7 NewPos = 4 We see that this new bucket, 4, is being used by C, and so we have to recalculate the bucket one more time: NewPos = OldPos - Offset, or NewPos = 4 - 5 NewPos = -1 NewPos <0 so NewPos = NewPos + TableSize, or NewPos = -1 + 7 NewPos = 6 We see that 6 is an empty bucket, and therefore, our table now looks something like this: Entry Bucket ============== 1 (empty bucket) A 2 (no collisions) B 3 (no collisions) C 4 (no collisions) 5 (empty bucket) H 6 (arrived at after two collisions) 7 (empty bucket) Now, remember from past explanations that searches are conducted by comparing each entry to the key until an empty bucket is reached. Therefore, to find A in the table, we calculate a bucket of 65 MOD 7, or 2. We look in bucket 2, and see that our key of A is the same as the table entry A. We have therefore found our entry in one look! Now, let's look for I. That's a bit different, since it isn't in the list. How many looks are needed to tell us that it isn't? Well 73 MOD 7 is 3, and we see immediately that bucket 3 is a B, not an I. We recalculate the next bucket, and get: Offset = 4 NewPos = (3 - 4) or -1 Less than 0, so NewPos = 6 Bucket 6 is occupied by an H, and so we calculate the next bucket: Offset = 4 NewPos = (6-4) = 2 Bucket 2 is occupied by an A, and so: NewPos = (2 - 4) NewPos = -2 + 7 = 5 Finally, bucket 5 is empty. Therefore, since we've arrived at an empty bucket BEFORE arriving at I, we can say that I is not in the list. How many steps required? Four. Quite a bit of overhead on a short list of 7 entries, but consider a list of 100,000 entries! Four searches to find an item is fast! Q3.3 Okay, how about a real working example of hashing in QuickBASIC? Theory is fine for CompSci freaks, but I'm a coffee and pizza programmer, not an egghead. A3.3 I mentioned that one perfect use of hashing is for word distribution counters. Here is one from Rich Geldreich that has been tweaked by me to account for some things that Rich did not know then about hashing table sizes. S5.0 WORDHASH.BAS [F210S05.BAS] 'WORDHASH.BAS v1.10 By Rich Geldreich 1992 ' 'Uses hashing to quickly tally up the frequency of all of the words in a 'text file. (This program assumes that words are seperated by either tab 'or space characters. Also, all words are converted to uppercase before 'the search.) ' DEFINT A-Z DECLARE SUB Show.Counts () DECLARE SUB Process.Line (A$) DECLARE SUB UpdateFreq (A$, KeyIndex) CONST TRUE = -1, FALSE = 0 DIM SHARED TableSize Main: FileName$ = COMMAND$ CLS LOCATE 1, 1 PRINT "WORDHASH.BAS By Rich Geldreich 1992" OPEN FileName$ FOR INPUT AS #1 LEN = 16384 ' In Rich's original version, the TableSize was set at 7000. My version ' guesses at how large the table needs to be based on this: ' There are 5.5 characters in the average word. Therefore, divide the ' text file length by 5.5. For safety, assume that as many as ' half of those will be unique. In normal text, half the words are in the ' hundred most common list, so this plays it pretty safe! It will die ' if you take a file that is over about 50% unique words, however! This ' is for NORMAL text files, not word dictionaries, where all entries are ' unique! ' 'SPLICE IN FROM EARLIER SAMPLE 4.0 IN THIS FAQ ' VVVVVVVVVVVVV TableSize = funFirstPrime(LOF(1) * .09) REDIM SHARED WordTable$(TableSize) REDIM SHARED Counts(TableSize) DIM SHARED New.Words DO UNTIL EOF(1) LINE INPUT #1, A$ Process.Line A$ N = N + 1 LOCATE 3, 1: PRINT N; "lines processed,"; New.Words; "words found" LOOP SUB Process.Line (A$) ASEG = SSEG(A$) 'QuickBASIC 4.5 users change this to VARSEG(A$) AOFS& = SADD(A$) DEF SEG = ASEG + AOFS& \ 16 AAddress = AOFS& AND 15 Astart = AAddress AEndAddress = AAddress + LEN(A$) 'get a word GOSUB GetAWord 'update the frequency of the word until there aren't any words left DO WHILE Word$ <> "" UpdateFreq Word$, KeyIndex GOSUB GetAWord LOOP EXIT SUB GetAWord: Word$ = "" 'find a character P = PEEK(AAddress) DO WHILE (P = 32 OR P = 9) AND AAddress <> AEndAddress AAddress = AAddress + 1 P = PEEK(AAddress) LOOP 'if not at end of string then find a space IF AAddress <> AEndAddress THEN KeyIndex = 0 GOSUB UpdateKeyIndex 'remember where the character started WordStart = AAddress AAddress = AAddress + 1 P = PEEK(AAddress) GOSUB UpdateKeyIndex 'find the leading space DO UNTIL (P = 32 OR P = 9) OR AAddress = AEndAddress AAddress = AAddress + 1 P = PEEK(AAddress) GOSUB UpdateKeyIndex LOOP KeyIndex = KeyIndex - L 'make the word Word$ = UCASE$(MID$(A$, WordStart - Astart + 1, AAddress - WordStart)) END IF RETURN UpdateKeyIndex: IF P >= 97 AND P <= 122 THEN L = P - 32 KeyIndex = KeyIndex + L ELSE L = P KeyIndex = KeyIndex + L END IF RETURN END SUB SUB UpdateFreq (A$, KeyIndex) STATIC collisions 'adjust the keyindex so its within the table KeyIndex = KeyIndex MOD TableSize 'calculate an offset for retries IF KeyIndex = 0 THEN Offset = 1 ELSE Offset = TableSize - KeyIndex END IF 'main loop of hashing DO 'is this entry empty? IF WordTable$(KeyIndex) = "" THEN 'add this entry to the hash table WordTable$(KeyIndex) = A$ New.Words = New.Words + 1 IF New.Words = TableSize THEN BEEP PRINT : PRINT "Not enough room in word table!" END END IF EXIT SUB 'is this what we're looking for? ELSEIF WordTable$(KeyIndex) = A$ THEN 'increment the frequency of the entry Counts(KeyIndex) = Counts(KeyIndex) + 1 EXIT SUB 'this entry contains a string other than what we're looking for: 'adjust the KeyIndex and try again ELSE collisions = collisions + 1 LOCATE 5, 1: PRINT "Collisions: "; collisions KeyIndex = KeyIndex - Offset 'wrap back the keyindex if it's <0 IF KeyIndex < 0 THEN KeyIndex = KeyIndex + TableSize END IF END IF LOOP END SUB =======>8 SAMPLE 5.0 ENDS HERE 8<========= END OF QUIK_BAS FAQ2.1 ' Msg #: 8968 QUIKBAS Subboard From: JOE NEGRON Sent: 03-27-93 10:38 To: JIM COYLE Rcvd: -NO- Re: BLAH. JC> Does anyone have a Date2Int function that could be posted? Thanks. Ask and ye shall receive... ============================== Begin code ============================== DEFINT A-Z DECLARE FUNCTION Date2Day% (DateX$) DECLARE FUNCTION Date2Mth% (DateX$) DECLARE FUNCTION Date2Serial& (DateX$) DECLARE FUNCTION Date2Year% (DateX$) '********************************************************************** '* FUNCTION Date2Day% '* '* PURPOSE '* Returns the day number given a date in the standard date format. '********************************************************************** FUNCTION Date2Day% (DateX$) STATIC Date2Day% = VAL(MID$(DateX$, 4)) END FUNCTION '********************************************************************** '* FUNCTION Date2Mth% '* '* PURPOSE '* Returns the month number given a date in the standard date format. '********************************************************************** FUNCTION Date2Mth% (DateX$) STATIC Date2Mth% = VAL(DateX$) END FUNCTION '********************************************************************** '* FUNCTION Date2Serial& '* '* PURPOSE '* Returns the astronomical Julian day number given a date in the '* standard date format. Note that the year must be 1583 or greater. '* '* INTERNAL ROUTINE(S) '* FUNCTION Date2Day% (DateX$) '* FUNCTION Date2Mth% (DateX$) '* FUNCTION Date2Year% (DateX$) '********************************************************************** FUNCTION Date2Serial& (DateX$) STATIC Month% = Date2Mth%(DateX$) Day% = Date2Day%(DateX$) Year% = Date2Year%(DateX$) IF Month% > 2 THEN Month% = Month% - 3 ELSE Month% = Month% + 9 Year% = Year% - 1 END IF TA& = 146097 * (Year% \ 100) \ 4 TB& = 1461& * (Year% MOD 100) \ 4 TC& = (153 * Month% + 2) \ 5 + Day% + 1721119 Date2Serial& = TA& + TB& + TC& END FUNCTION '********************************************************************** '* FUNCTION Date2Year% '* '* PURPOSE '* Returns the year number given a date in the standard date format. '********************************************************************** FUNCTION Date2Year% (DateX$) STATIC Date2Year% = VAL(MID$(DateX$, 7)) END FUNCTION ' Msg #: 9012 QUIKBAS Subboard From: GEOFFREY LIU Sent: 03-29-93 17:53 To: JOEL YEN Rcvd: -NO- Re: DISABLE THE PAUSE KEY JY> Hello! Do anyone know how to disable the PAUSE function of the JY>keyboard? Please leave a message to me. Thanks a lot. The following routine doesn't really disable the pause button, but turns it off 18.2 times every second. 'Stardate: 02-01-93 'From: EDWARD LAM 'Conf: NANET-BASIC (44) ' Because B_OnExit might have too many routines registered already, I've made 'NoPause a function returning TRUE(-1) if everything is ok, otherwise FALSE(0). ' The B_OnExit routine does look a little eratic to me in the environment but 'try it and see what happens. 'cut here for NOPDEMO2.BAS 'Example program for NoPause2 module. ' DECLARE FUNCTION NoPause% ' CLS PRINT "Press N for NoPause, U to Unhook NoPause, ESC to exit" DO I = (I + 1) MOD 1000 LOCATE 5, 5: PRINT " "; LOCATE 5, 5: PRINT I; A$ = UCASE$(INKEY$) IF A$ = "N" THEN IF NOT NoPause% THEN 'We call NoPause here LOCATE 2, 1 PRINT "B_OnExit Full! Can't stop pause key" END IF END IF IF A$ = "U" THEN CALL UnhookNoPause 'Have option to disable nopause from 'within program LOCATE 2, 1 PRINT SPACE$(36) END IF LOOP UNTIL A$ = CHR$(27) 'Note that we don't care the state of the vectors since B_OnExit will call 'UnHookNoPause for us. You can call UnHookExit as many times as you like ;NoPause2.ASM ;Note that this file has been modified so that the UnHookNoPause routine ;does not need ever (or should it) to be called. --EKL EXTRN B_OnExit:FAR ;QB's internal routine calls all clean ;up routines registered with it ony _any_ exit ; ; NoPause.ASM by Brent Ashley / NoPause2.ASM modified by Edward Lam 01/31/93 ; .model medium, basic .code Old1C Label Dword ;Label for to old Int 1Ch Old1COffset dw ? ;Offset part Old1CSegment dw ? ;Segment part Hooked db 0 ;Our installed flag ;Note that if an error occurs registering NoHookPause, NoPause will return ;FALSE. Right, it's a function now instead of a sub -- EKL NoPause proc uses ds dx ;From BASIC: Ok% = NoPause% ;Use UnhookNoPause to disable NoPause cmp cs:Hooked,0 ;Are we already hooked? jnz InstallExit ;If so, exit ;following section just cut&paste from EVENTCHN.ASM by Jim Mack mov dx, offset UnHookNoPause push cs ; push far address of UnHookNoPause push dx ; to register the exit routine call B_OnExit ; so that we don't hang machine or ax, ax ; registered OK? jz ErrorExit ; error: too many registered routines mov ax,351Ch ;Get current vector for int 09h int 21h mov cs:Old1CSegment,es ;Remember it for later mov cs:Old1COffset,bx mov ax,251Ch push ds push cs pop ds ;Point int 1Ch to our code mov dx, offset OurInt1C int 21h pop ds mov cs:Hooked,-1 ;Set our installed flag mov ax, -1 ;return TRUE for ok jmp InstallExit ErrorExit: sub ax, ax ;put 0 into ax to return with error InstallExit: ret OurInt1C: ;Our Int 1Ch handler push ds ; push bx push ax xor bx, bx ;point DS to BIOS data area mov ds, bx ; mov bx, 0418h mov al, [bx] and al, 0F7h ;reset nopause flag mov [bx], al pop ax pop bx pop ds jmp dword ptr cs:[Old1C] ;Transfer to orig Int 1Ch NoPause endp UnhookNoPause proc ; from BASIC: CALL UnHookNoPause cmp cs:Hooked,0 ; are we installed? jz UnHooked ; nope - exit push ax push ds mov ax,251Ch ;Unhook ourself mov ds,Old1CSegment mov dx,Old1COffset int 21h ;Point Int 1Ch back to original pop ds pop ax mov cs:Hooked,0 ;Set installed flag back to zero UnHooked: ret UnhookNoPause endp END ' Msg #: 407 QUIKBAS Subboard From: CALVIN FRENCH Sent: 04-02-93 18:31 To: EARL MONTGOMERY Rcvd: -NO- Re: 256 COLORS Er, um, I'd have to disagree with you on that one. Ok, here look at this chunk of code I whipped up a little while ago -- Maybe it will help! Oh, yes, thank you very much for the code, because now I can write the Palette vals. directly, which should help me greatly -- it's much faster, as you'll see: ------------------------------------------------------------- '--- FADEON.BAS 'An example of how to sucessfully fade on and fade off different color 'values based on different color values. 'Released by Calvin French to the Public Domain. 'For the discretion of all QuickBASIC users and anyone else. Please feel 'free to distribute this file anyway you like and make a buck if you can! '---------------------------------------------------------------------- DEFINT A-Z DECLARE SUB Fade (text$, red, blue, green) SCREEN 12 'works ok in screen 13 too! starting: DO LOCATE 2, 1 COLOR 10 INPUT "Text To Fade?", text$ INPUT "Red Level?", red IF red > 63 OR red < 0 THEN GOTO DontDoThat INPUT "Green Level?", green IF green > 63 OR blue < 0 THEN GOTO DontDoThat INPUT "Blue Level?", blue IF blue > 63 OR blue < 0 THEN GOTO DontDoThat Fade text$, red, blue, green LOOP WHILE text$ <> "" END DontDoThat: CLS LOCATE 1, 1 COLOR 4 PRINT "Valid Numbers Between 0 and 62" GOTO starting SUB Fade (text$, red, blue, green) bluestep! = blue / 63 greenstep! = green / 63 redstep! = red / 63 LOCATE 10, 10 COLOR 1 PRINT text$ FOR i = 0 TO 63 STEP 1 PALETTE 1, (blue * 65536) + (green * 256) + red bluetemp! = bluetemp! + bluestep! greentemp! = greentemp! + greenstep! redtemp! = redtemp! + redstep! blue = bluetemp! green = greentemp! red = redtemp! NEXT i FOR i = 63 TO 0 STEP -1 PALETTE 1, (blue * 65536) + (green * 256) + red bluetemp! = bluetemp! - bluestep! greentemp! = greentemp! - greenstep! redtemp! = redtemp! - redstep! blue = bluetemp! green = greentemp! red = redtemp! NEXT i COLOR 15 END SUB ------------------------------------------------------------- Umm maybe that will help you, regardless, the method of changingthe palette vals using PALETTE is equal to: PALETTE ColorVal, (Blue * 65536) + (Green * 256) + Red That is the formula, if I remember correctly! Well, hope that helps out, ' Msg #: 536 QUIKBAS Subboard From: JOHN GALLAS Sent: 04-03-93 16:45 To: ALL Rcvd: -NO- Re: ELIZA.BAS 1/3 Heres a PostIt! script for an eliza artificial intelligence program. I would've addressed it to the person who was asking for one, but I can't remember his name! So anyways, here it is.. 'Save this script to a file, edit out all of the non-QB related text and 'execute it in a QB environment to retrieve ELIZA2.LZH. DEFINT A-Z:DIM SHARED A(685)AS STRING*63,I,T$:FOR A=0 TO 6:P(A)=2^A NEXT:T$="abcdefghijklmnopqrstuvwxyz":T$=T$+UCASE$(T$)+"0123456789()" G"qIuylSHwnTK7caaGKzaaaekwZsasajuetjPvqUq0tdPlrnbaaiSmDAATruh32KPA G"fL(3tSyifehK006ILqqQni5M4TnjlolXZw4kzWU7oBC3mADf)X)Vx2AkP4COuLSu G"5cHV)GDYAJ2ycdynd)Z(ld4(ZCTTxNA1to9Ilmp(kN)p98Noh6)ftyEZl13vR2Au G"YxBwRvR26wzdlkONA7APWng1AdUYP5MTxTtfNkNT6O5gEflKfB4DxjUnLbSTn2QH G"wfBZdtXAzRoyRix6zcABRQt92FvadSX(BlIslBq)CzBwX3f7VRUI07QkuDhxyr)j G"OUUPs9(93JIx61bDUDAJDqvE5NCVEyQTUgoxvA1Yk1QIr(T3MHaU7vnWpVyaR61r G"WZUR9FMT05(gKydmw1ZLPQHR3qxkme2watJJlfmN7SUcJ26vDZG30wD06tzTHD22 G"zJIEvv6Gy9JkgQqZw2k7(vKzyD)XE0AG3uhBSuGt1QyTpgB1mQJL3RRDgwlrzI4u G"pXfM7yFC8dFeADwDwlbYYspd3Q7v4k()n0SMjRBPnATrQJsvXgcCYImmP2MVhOot G"x6cq9vLXORbI4Gl2Tvf1q6CjxziIseMsz(IlmMLQv37fslATcspTGpBsp6DBiCrl G"31Wl1uNwRDYH7e5d(wNA3CGYD7iYmgvzBocyVLa)EZYRo(nuwpDbn0V9GcMDb9j0 G"0b(1RlQKWnUDuV8qCmL7tp)gia9nfd52MBdZRdARTzDV7OincRSg9p2F9Ilz54qW G"kd(RzLxwRd)wTGCt2P0ZvjSdLFY3AdMwvUTnJs)bfxcJM43kTVIesAbz5LPDASPE G"ROvZcE2riXNWedftANrnNiJtzKGvcGIV8bPYr93vfPIeWnuIeho(UGIlPEBn1qtz G"lCKunJIFmnR)OFedKe451MqcysO1Y0g2u416(cuePWihPP2AqsPZRbTgkOxb7IpS G"gq6sDiHvO715hdKJN1cmy95iinp6TVCN(CKNuAoHsiNtThFe5k25wYw9a9lVffCu G"WEgwqUuTFDPG9L3(ZnltUUD9StQCh2fG)1tUvA5qKFN)IugHn7LAkO5inmrTDPtd G"Qig2vtkKQGDDoe7YkSxNvTNXJ2vYFVQelR58x1CaTCmsRNIcETY57csqyvyGaawk G"Tr(F56i)MNPfRP7WvF(e)jfM9oLepQOv7BnSuRRmmSDXKLgVt2zfCqv5e1Vt56gZ G"1kLsk8ib9hNM8t1gKOkUUK5zw)pbAssxG9RbkWExRroKpCD4rYv0AoORXtJKwRKP G"6vP6zT31KRi13WEeJMsBMY)e50fxb2HyxEUhH)xbKdPuoG3JpwNfs)fdQjbfeZWC G"uCn3rtBhLuLvwoyuT4zlnwxF)2u3TsCV(R6fR1MGV9n3bD3Y1F9dX(NvOQleek4y G"4cKEGhHSD24F4j)dl)t62wgMsPMBaffaPK3F70IP)FWW(pdkIFIaOhseVgOvIPfC G"zAd0MyqDyVF6gAIR5SVlUIhxUX2iD7YlAH5TUNKpTyXHIWd05JTgRSMPzP9gf5hq G"CnVsFjsMruXiMURX8ITS2fBeU8cucDqayomA6t944rEuDGpaw0O1X8H2VI1EJG4H G"FUkM9bKTs61Dc3oFJp1cTnR1GL4(KEzzF(uJwT5VTe(2Wp9T4y2wA(CDJbV99BzI G"erBOWKjfFI5TxkcL9fHOQsV7r9qJ9LViAjno)rtTaHRr(aNAXgFQ3fdvkJk4Usqn G"ItJirinrDzCXBQDqqJvxWwIEynpz162vakB7Sm6wXu8gnGJq4JTpIvOEP611kh7e G"BWRj4nx8izbslJ2qBIHEai6eEK0a65g4m7C2wod9La8WPqdQ6gcXhEfITqHnnZF6 G"fdqpiehZL8Pw3QC6vyK)beuxewldMXp(e78RaLYUh52oA41QzXAL6yo3kQwKmqRT G"sw83fOzoGRie9B77LaJIpm4ldsGxtD0rmbItSrsmo1j(4v6qLEQ6aaxakfqsemur G"zaVpIH(7ckaLKIm7CLHo)(st7ZRqNfbMqOMOiSpRMu460RVFPEb48GbSvwHws4Mw G"NyMYT5g0SlIDfmcDhKEViF8gVJYrlRt2neNIAsqjmpa8YfdJjplkzKAzDLfnndPd G"ClRk17nKCSGbmq4VSySK20RJOY6lI39Q08Q(LpqcbBFaBUtjsLNOvU72Zhpy3qjy G"OhdiWI)sayhXofnKhhas913z90vPCJStdmg21zj8Dkl8v4IBCU06DLuevJJuq5vO G"Na6nqSOj7i7ukNu9)p0t7)I2b)bXBf8et703KmVoYOOvevlLU1jrVQ04jIsrqq9e G"8lPLlNUS5YJmIiAZDh)WcgBevDgsIe3t8prCBInCKw4vSLQ7IvVk2QVsE)6BxD8h G"6dblnXrzokrYwfLXoZAEWUiAWJx)YtOTbgvt275RxxgJm)E2v7NQE1Xg2YGo1zZA G"HZxhoC5ShUSVfw3()VK5QpLiD0D)(ZtcPii8W9nlPE9kxzMMKGig1W4Fx93S8)ri G"RL)97j)9ECi7AaXMBGw42sw)sUv2jODkHyEy2HTLGh66jzL1gVH74ECA7b(KmOuo G"RDgPnqsBCHT5PRo6nl3D1XN(5BwydocMFutDmY2EIy2woFvbPFZKeXqPIMSw(yq4 G"iRm7fYnldc(eFXffulOGh)AnWF4n05NfYvNLZGrxsu31oPnmIkgkQcqa6td)tqcG G"LkFdr1llgIpjvuqXQpYImouQaJRtlbyMwKl3f4u8x8kErUactbBs5JSzl3k2ArLh G"vcbcPwuXoNuYJXWX7nDssXZ6WewGJGa7XivNDLiA6gjyHs2e5Cwa1vPDLE1(Cpw3 G"c5P59kXOPVJ4llJBJGrf49URx8fqawBBPzkCHaCZGSy(XUi5cU5Obv7N)uKfgNeO G"QG7yVeKkayb(Vk0jn01KKV3jXQBbrwAtiqgovmFirb8jtWsupczmltpYIdbcR8sC G"(7uGinoDs2rxYkws7IvbH5kmzz2J1uWvaofTqI9pdEtS4DGssfUTvkydeo2cAkIG G"eyMsSzC2yl8wjXU(AYM470eOyer4sjsuw18TdAGjDk9WNmV3DtwDPcNasQitbuHU G"1tKgQE9iu93Gp5uwt9BYqmDC7MR594waGnY1vS30h6NG6sNiBauxCgXXBJp9MZ(5 G"wVZ(JDKjgL8IBdGLmcknVHMcEyVI6wWra0A0ZKtIpo4xmHoz0T6GiSOymh45BYdu G"fdiAE8nFnQq0MHQVG0iEXN)DRW6MRXz1)U(7)(h1AEDSu3APItko)q41QC8sycxk G"28IVZSCGeyGDSCb1HyXSDWR7Ikv0xGMyVjYBgAazIKMlhdmnyqnsxSycehNWOgE6 G"XTjwJsFWfzZ4esPupnTvgevS83Qy5bTajIZp6N1Nv(RTr0uQ3RokWchaicPNbOjF G"BfxoH6s7aFKeZVBxOkrb(B6zq0dhWd8HVdhkGV9wiigqS5Jd89lYWqKzieuKqjeJ G"OlBSbhJD0YeNKlx7kwzJoZyRItyFSYQYUzTR)TWgKX4O1IoGqIk)T6lpXdEEHWP2 G"oR62bUQckgUiXAxed4KHihWY1ZmwVDDU9WPNpRsduDmW0YsYwp(hU)topagwtemo G"4sePgXVYCzSqYt5ZlhdpH61fRhjLsEIEMjeTdy7T(4NBiX1ut6ZKtkbfG(O1HxKw G"C8RyH8xwakBmJywk8kGmzKYx3cNy)VhymkmHfODbk)gLUe4wgAGrpnfQP0NyPONb G"1SEc4OHUezFBVqIg2g9F0y(Xf2k2mzWLYjfOznKnkuvtZTDitBYuD4kKOP8r0jQX G"eW5ojoZjsqpnPnFuswloJ41QPwbkyjzFFV6isrZhjawwCLNkowLy35VnRAcvGDrR G"klslTc(JwZfjhd5mNkFmWY)WS0NLd3YXJlzC)PfSSZ(9IvYhV)b3X5nAWyPR4GHN G"A5iA04DUZMZU6QIYMC7aLCijfjLKBW0(n88CN5cFfMHIW5lJmx(xRS4tMK2WunK) G"TuRcTYebYk6yIceii5my))39arbh7JBEZB)5s5IAja5fG0NQUwsdN89iz2X99HsW G"pyqX1FU8Z4CgDATtZCymDl(vf4Efin6E0toIjahy3RaoxcYjc2BUhOYtqNltXVk9 G"4D8XFpoA14R3pV8SfqicQTWgA10I2jaaaaWbaay)IDAfibKqrmLKwb5crbrfz71e G"xaaCqc7zx14A(D87vami9tjHgeSfm(uifvgsW2pPb2A)uZNKBU4f5(UxVjEZJKnn G"9csEzWltq5L7oC3S2iTLRDwTFfAPDE52pV8jNR3mp6uEYxwuZEwr)mzDEq1vxRjU G"X8qBmXxj7nx5NtU6VEg64PsVSwRLEPDPlK12q2)ymm)HALAQnkeRzLnDmP1mJXVF G"FE6NvOLFE5V0QpuU0p(PLP8QPTK70T)uRUv5LmYQdVXc3)XeJtfpFWOM(JYZAzfY G"rTI0lBruG90jMQ8BVBUwz9knpIgk5VF(5LtrF6KsAp2Ql1ltxZwIEYg0aNXyUDmj G"8h0GnYuZSM)YZWTSSng2Q9QTF16mPZm3SuSKHjyE7iKPn6oqiD4WzwiTspH(wTyN G"JRnQ0bQ)AEd7mEgPhGDnCbtc7gJFU2y1(rhJQ6yt8PQ)5(3xFZFvwGDxrASCQcp3 G"7SBiMQKwwCRYS9SrHmLi1Ig9TI1boET1ZwLIjHXopU1yxdrQrICS9VelUf9RIGcc G"inar8L9rS5cT0gDtsrKDZSQklSqxvtYEFyTbFH(6BVzPblUeSSQMvSppN(gCBDop G"FltKqt4OVpHh6tXLy)AYrLoHKkg)nRbX(VIJUNbtB9E9ZCXyBhPq8HU(lo6jdYQ5 G"0O)lsxtS2FOSRVPWIjYMeMDDH0QLrAtoqBcBaNt1JTr4cZa63dpgfyOCGnNKmzEZ G"kkErsVQYO977ToSgU1vn3G)(yPe4OX0)gVR4)1V()VKvULc1xy)Go0Bl0clRzi8A G"A9)w7eQpVmdhkLJLkzRJWophJQ)0jpHqaZl9nDV)gwohr(Fs7b6Xwms)xbGCJ95F G"BDulw8SnF2V)kNfoZkiZCpaILprCqDWPyb0CD3f66GVdNr3gjkudbhSf)w4)hqlj G"MNjYdo9mFdXe(F5HEn6Hi2Yb9e75dFfXlimbgISgruxbH8rtZOKXdcThDh6fSeUx IF I<>80 THEN ?:?"Page 1 is too short or long!":J=1 I=80'Page 2 of ELIZA2.LZH begins here. G"cnuCgXmsNYUpk2hZbhbcAqSSbqxkfHzcPtrMq729LSuX2BMfJ)hej5zvSl40)O4C G"Ldr4JPqMja3RdDS53O90xQAqlrdVCbQYWhSOjZ1dA931O2Tl6z07CTR5jmf5(SIr G"WE2lAf3Cin0rYhlxnnI8WzNs306ZSAG5ZGm7XyYJx)6EcU7OCprrEJRRMJxA660W G"jJx0r4(hOH0CPkOGSlhKxLkSFk1ncy7nMD9I9uj1nPVUMk2MtfL7hYnYo7syRgGN G")t4)l7vs0g2cf40WpRoQEJhW9QYc5j)b25Ddqq9Xc(ca9G33dewq5PeqT2Qt246k G"Qm8PYuuNsTg85l3zkiFXWo6n1BFUPDwp1lJdBDxvdU)f7XuGVxygqpXC)fJB(2FT G"Z2)W0otxD6cXkVttLz23KePY5Tj3h1njkp6rXe9ItRJccPglQOhUlkOFUrFFKp29 G"qf(SDC5Gqcl(D3DaCPTpBlTa4u28jRU15Vgm67RQmTRNdGXtyTiKyEa5vQyGowX8 G"gs1HTQeYvLmm3RRiOYC(cPxFyDh8lKHespf0rasfvFFVn)D2JzIViD5DvKoGqFta G"Swc6ImuqncWTBfInTIGntcHm(8BXMztsPPK8xhD)WtDjPT1U)nTwwTfKk8pBryXV G"zYIhuFTGrpie)Q)LbaE93abLhCiWPKa3MTz3zCeTERCYJ1IyLm9yRNPs)huwqsTF G"0yi2)eHd2rHRvUYNCYSMOV1(y3r3uOiFGXgqwSUrUFCuMqbABGT4WtXLZNVyP9Ug G"AggyIYK8o0ZI36S5kw90ZDJJaGKoAazChyzr4AEomLdVCJanGaY44hDyGXvQn8EY G"5xXKRLkHnv)IE9ORzAsgL2u1Sq0rEV4yOH(lT2fK8d21gMunchvOb6mOLGTZ09ry G"mHiiZoARWlobhbglOLbmk668KUPeJbKWznc(rX2Yg(zwl634yPmMrlNhczkuHWqT G"NhYI4hAbBuetgtqxO8D5Etge)HpPL7wojteauinsmgoODyWYAkYYQS)qwdCmfhc1 G"gx6bTC6YQdLAa3nXytetktVUCwhyc45W0AQbn0LSkvifQdwpXyikxtdn1x5C7lxZ G"UgSqVBlj5pyoY5c5QjoRu138yIuswF1I4e2(V9a2tJ5qjePiTEio1hECkG1zHhNF G"XsocDo)NkoD2fArtZLJ1(xj9ZLu0fBNSMLZZLYqHfHN7rmgpnOIEN)FVEMVZVfrK G"tUEuHNmipsseIOXHbZJ8GSUlVqg(m9SWZOttzjcCFZ0UQbtH5CmtN9kRzJf4cp45 G"iDLSMrx2yNbFwixe20k9UFaCQxOfXnN4YdZJViYUoHFt4I7kaoB)abYL5wDMjihL G"REXxQyJ1fEanOiFAqwvwiQ5mv(GM)qiq3D6VcL(3MtFqsMhylWkWswrUtpOaiPkm G"D6Uzl7umvTzEPXcbLQpU0)thcp8KJP03fCLB5aviIjYXBY9XMJB9A7DI1V0wOheV G"dcJsJt8PBs0Ouax8HDqNvCkoWGJFvtTd6OX2O2KQfzXTrOarGYgAzCMp0LehiRr1 G"jX75ksV6AdLPvsMz49m2IZtFFt(abvtxZ8Qva4WUwnpB(IkjYDqkHuXo)TdKmExp G"Lw1Xh6Qd8u(zRBoxCEsZfNVneJYFSdNeObmzSLU2MmAYnBYzIeHahWS2S)Q0LAfc G"UdM)uUqRBRXC0m9BPwr1HT7TByLS6))QurvGyloKACmRrRm0LgPAHkQzcWUUvd4a G"sJC6IEqBpx8UJLeCGRKtj92Q3DVKGPnXSHciXB6RIiCY(wlGG88Bt6vdonhJtICs G"U0Gn2DlUP(sVFg9wi40VvL3YyYATXm3Twfzgp9IUznJ7j1ab5mImG(RVaGIjIz2E G"s8Py0GKtphsoTO0H9TlKl)Fk73bIklpm7NMrxitCNKeaEqB)QdMc9hIzZwhQZsSd G"bNdrcfiduKr)ddRbXWd1aF(EqaUNr8jLk5jb2QS84lnMDydDFsd47CAJMeooQmt1 G"z1a(QIi1hKBV)8XfTZnHIutMKEvAZ70NnmRBnibOLgXeuyRc60oB5pC09UgiSCRI G"yLJAxI5AqizmVD051ABCscCSADbDFVZJdpCfp1q6Q4ppCm2cC3w7b9RMTvq0Rgfe G"AKeJWalPs6ha2smKZDO76(isUsBvvLpGxn1kXyhNJM(zQrEDY8)gqybd1Qt1YrbS G"7Jxw(uA5S1b5LQn59lDpHuPpLsPQ78ieuyOaineFRSGokkJvBlOW9B2KoLo94LVK G"YcleYFkRF0Ra7)nJhhprEn2qVgXZ9MnkEmHa6hrPh8)LoouMqhDd0f4VZLFWVikM G"R)AM94UlzjxmGJT3MXa6YOyVS0BZsd4qMmE8NpFXji)hoMseD(I)Oi4uthlW3sGA G"QdTQhAhtLJjWmtNTl8uI0)rYG2oerFozZvLIy8BVisGbuBMbhm9LczuoCcz1bbyL G"PtV42O1MpIFOBBFL4ANM9)2()paIarlSHwnTS2caaGxFaaaAlwZsasajuetjPvqU G"HiuqtH2rnbaaiihDA6ER2u(nyL5KNrlVopZMGedIyaq7YfUbiwnygGqKxttUWmVy G"KOtdJjvr2(HJ)))V3YdusNS1E1Uh4pIMDwTFV339QTz74vf1WPtVvFKzZQ)x97nP G"bOCi)qxCA0CXlwI)xV47b1hABsMIrUrI)WAux6hP1x9p1bRTnp94JJsHqZLIF05B G"skkFBOdK9vI6mXe57pk2tLrx87tuOE1n9bJv1JplsWgVdLqAKQv15MrRk3wXQZCq G"J(ZiGx9ENycfXfM9Dv3YuhLe1vc6sBaBUNbRgWM818LKDNSHY51rxC7RShdAwVYy G"7ZR())69NfnCk1CL69kIhKVHrafFRba9HGljfjvkkxp7TtLF0I(XbFc4iTKIV1Uv G"v(gPTRIcQC93W3ZzbzDno(o1zZcJyihzhQEfj(7eTRqOOKlbljKu4bXaT5uu2BMC G"VWg2Dyf6vlAqAAZOLa66xOp9axWAmgiRRIdQVo6Hw8w4bL(Jk(NxYymObZMkLGVM G"8F1Ckvb38hfYkOt98fz3mWeeeTbp7mfeMHYJNXwEI)hxeoKTI6Xc7IKwEsPGe(Kq G"CLW)76)b5iEffcDSF73kZeD4U6sdYoIEOWVViPTNpwosfkGu1L00FUiBTLvHdBH3 G"a1ziWdKdrMgZZ5R0zAhTO(1wqSItiXOP3ruMjfQC3pPIYBd85c1QJlM)sE5hw1Q( G"HHe9fIsWRNtGXuo71j1FFMx80lcOHhBVdV4CcVmX29OhVu4aMX58kJmQy89cAgGW G"lbeTK5qct)5GdLV3rgtOWGwkgeggcSfmm16Ut6XjBnKrMrPIT5AqOWjGdRXDb19A G"EFgdNfL0yXtv)oUtu6PELk6VuX2LuXYvo8K3geNO7pzA15i)TPoFLBOtIxNelDix G"tmxCJBvOv4dh(U5BG6osxvDMZu2Gk(E78kh2tHmxKmerb1P)nVDUY70m11vTZ6gU G"y(1sBoanhN5dH37Xxdr5nuu)WUxShca1H2dvdqJk9qZ3tLk1Z6EdG5MdHPS7n7Fw G"WfztxGUg0aftjNmcpdaePjMdFbaGB)JG6ndDgU3YULAI)YTJcuiUmqx1JrJ1yrmR G"NL(NcefmW)QiE)rZO(MremKWregZshaIC6ESmLPYFpN6pUlvYOIrH8uWgGFiXicK G"Wv5OaoePR)LjMZE91SGCwXhA5TBENSwEILwqKopMcoIUe4)lLjpGKVeT01Yk0Mxu G"nQj2pSSnKqyxTv2u3n7SgA7hVPgduOhRSu8hyTgFXVCfFJQdcJ5im6CQBUkTWmwL G"YpfMpxQi4FaugQu(pOMF54a(ZNJ9frWVIu2mYm4fHycqCz7yyseMTRpaoyB9IITw G"ISCvMOb7X78NhsT2KaDRhNZeG28kosm2IqLR2uWqKbl5T70V2en5o7COtpZohAv3 G"(oPJwVJYgD4Sj)ZkHw8WuDBC2w7vJiHPfqDHcKinH(U15QxysywneGR)geQKvdEz G"rpdUzRpkjBDA(FZ9WU8OIQD(Kos65tjVWbcdv6aJqaEHEKGJ1O70Bjatu)IFzscN G"RyPnws1nRLme2kkOHDkpf8yfw90xlfigZDOcUtshJMhUDz0A4QZHtFJzgfD)93zJ G"LWtzegY3inFmuR7MUMZtvNiOuSw3AkFSvvo2QhX37QzooPdb)kakeM5ouSSklOyY G"sZrMVvsuRBwT06FE)iB22cbcF4VRTYqQHliHhBcsOtDGWLcbXrG87XG9ytVGCENq G"tCM2ueajlKdzqGddbkuw3rN6RMfVbsHdX5ugpjLP4YNziG6YNkWRaiRArSjqkhNf G"V87jb0MtcWTRcCIZAQN9b5zthU4DGyjUEgimSZ4uTJUNpdYZsPPhrCm43tSo9R30 G"awuhAN2MtA(9KMABVQmKPb78U2V7irBWuIeV6RuVsocaON)gu6u2c0KJqEQqBrn2 G"tXOmgLUeAAOv26eE95ET3wYBrtjTcWaZz53eFfT4QkiE3kBIFbFJ1FV8urrxYGRF G"O)JVQoUiWDDiuI7CsloUU7EkwVc8832MwRw8OSR4KuGbrLr5gwH1XfpjFHlVGWvo G"E5nk4f1KFeviwEhi1EhO3AJJqqTjSWAmkB(LT42g7Y7BHZFdNpffSKqI9tnqISfo G"V8cC38RSw4Q9OkvL3tsvEycRKhaDnYpj6D72enhWmx(OtI4QNGhHSXukgjKbWEds G"8wIwQzBJXTsnfRKUjxqnjQ(nq21VNhvpp26RQ9)OQCxjn9OjTNi98pbBszDk0os1 G"rcoFgmcOxOm7ZRxBGIfDNWIadxgg2qgLavW4hHmcRSL8j9UlTYwDLsEYx2BEB(pZ G"prlfqFLtSJ5g6sZpOF8Ihgdy8Jn1Jo7h7UsRG)BW98ecwXyINuMrqKVZIQEIFwA5 G"WIHDVWtfGwMVuu3PamZqJLcAjNj)SqQdJrm7nuQfLcW4W5b57JL7MctKslBsEE1V G"DP5ALv7a(3AW5stcxYV3wOJkPiUMfrbSQDw9YAn7GTYcBBh54p(WnB4O92pHM00l G"UKWVNu9G)HAHcVMVcX2eNE87S5lrCJ(Q181QQOdHItihkEVyozU21ZSn(MmE1DkV G"ypY71lQQDU(q5njrB0)hTOrrcs2ZKs8qRA1ofqVdbN1r15ezy7otmmeLGFOFwTAm G"5VcvO)6dIkDo8KGMa0)riTe4XvCw4AJ3dxScEUv4X153BXvlsOIxTYRiRnmr3IoF G"MreZnoK3WGZGJ1R2I7wp)E1A59v1R3ILRWhHH6uF7UfEWT46AjJeTI5vP2Zn8b4N G"GT3u1JFdj(Y9SVTgneHS46dWokSGefGuw97Ix9F)BSL6AOf(pOGBydpTEj1CxH3e G"CUJqEAfudMcColllcjztGU1maBMejI3WROA2U)E1f7AvdBsqkNgcHNN4Pw0dRoyD G"zA67la2UOFBN8M8ycGzsMvGIQvAsGtscxO)aspArbrurvVKcoKrxbnP0otouD0K0 G"EfiVDStJSBqJgeBgNs8tyOQko7SqPqeKabdxYxQ8bjCjSs9lDqZk4cRB1MnEraEH G"Pn2GLZXey8eoEeAQCJ8)(nPqLz)gW4fbK51POgzx3MMkOm19CklQlXRxv3d2sB2J G"TRsL0ao01VQL7dfYQDZ(G3ieSl1RlBpAJNNC0ZN5rY0MXHNmrEROv3T)kou0PKD9 IF I<>168 THEN ?:?"Page 2 is too short or long!":J=1 I=168'Page 3 of ELIZA2.LZH begins here. G"(zWASyHtkwvhml3uxopxL3fHlb4cf0HiICe1Xo1BAoZf5fAzacri948J)ulRvpW2 G"ilwGtPZdhwwnroCzp99pH(H3tfMevflHS3WrOM)VIY304eaFM2i6T4XcBI4xeZi2 G"O3Dde75WTZc42XIBuRGxzaLu3L(zH59R7tCftTRh3PsS7sPL5BUWhWKXSjH39wbL G"FzYCC9H1mQB1lZL0G7a3f88VQ7CbSE4ZQtscyfMs4W6l(i2op5BV8(Hj67VzAI6k G"8ErK9ZwsRF)jbC8Uzp3WANtgJU23VzkytV4rZOE1leZ7zn)sGflk4YXcckfyrkhW G"1Uh21Q2yx8GPPvaDmXrkZC52Yz7QgEeT2s(MZEl6(TNqw7(PsgS44sDMzs0dTEZ8 G"3q9nKOrdlyTYCmmSjxTRVeYoo9wLwZtaR2Cp)d15k0vl2zLu9JEKsRVuT0rTwlXU G"OOqjKP7R5H3QUwOcllJ0ANd8Q8h62sBUn4tbP19h1s(y)3feCtmkUcO0VoAgHaxa G"at39yLiNFsVfvyu4LbWGgiqh3TkIBaoN4ATyeycFs(ezftjemaXXLJxzoHN8HPkU G"XDfMNmOZSpKkUi2Vkiamg09sJs6Qm42NgFq0AEWpen(IGDlkii0LrxvWZUus7kma G"5GV4LwhbTqG55j7NuTHVANvx)(SV8BRZ(Xp)111x9ET3476YEjITaMfLdqlKGfaI G"t3)TLypUUs7e2dyL7TCGMeg3S(tyS)vUP2h27zYtiLcyvy6l7B(xaDqVOLpC(WCy G"XGuZiYVV5N5Ey5JjMdmJqc7n8vSV5O515)9NFwxi)pOm0Q90P(ek(U(sVWeZ4LNP G"q)a(HvTWgA10IebaaaQkaaa8WhhJbibyavtnKtfrvrD2eaaaG6APPWMwkp4FZF3t G"0rgXKwG1gx7Sdj84SgYC5DZNNKlYVNYzGFuGouCbRlmFvaFkdCWeeeA5EthsPi5j G"Y9DVRNE(Eo29U5En7t9H870cQmXnQeyeKe7Ny5CEfUc8SiF10gIq6DS3tbfgalFu G"FLAIKivBA3MkGwzq8vgWOdG5p6q3iE)hG9WnfBQYaS)(Yq6AeG13SfFaKkxwrcu( G"mR7N9II5bRNnbwAP(zl0dgXRDqqLbgJP9sqrUSs9xOYJdlQFRRt5kJwuit5vX8d5 G"z(q0pVSvJmFkgf5r3baAZ7aOMu((O6NY)XDBCRS0(ZCoAlhn3fV8rQZBBFiztmW0 G"nPFtIMOJGIyrxRagJ6LOqVp(q02g4hQ9FZla" K=255:IF I<>188 THEN ?:?"Page 3 is invalid!":END ELSE IF J THEN END OPEN"B",1,"ELIZA2.LZH":N&=8862:FOR Q&=1 TO N&:IF L=0 THEN GOSUB G:L=6 ?(100&*Q&)\N&;"%";:W=T\P(6-L):GOSUB G:W=W OR T*P(L):B$=CHR$(W AND K) L=L-2:PUT 1,,B$:LOCATE,1:NEXT:?"File Extracted: ELIZA2.LZH":END G:T=INSTR(T$,MID$(A(L&\63),L& MOD 63+1,1))-1:L&=L&+1:RETURN SUB G(B$):A(I)=MID$(B$,2):FOR Z=2 TO LEN(RTRIM$(B$)):C$=MID$(B$,Z,1) Q=Q+ASC(C$):NEXT:I=I+1:V=(Q AND 63)<>(INSTR(T$,LEFT$(B$,1))-1):?I; LOCATE,1:IF V THEN ?"Physical Line";I;"is bad!":EXIT SUB ELSE END SUB ' Msg #: 512 QUIKBAS Subboard From: JANIS KRACHT Sent: 04-04-93 11:00 To: ALL Rcvd: -NO- Re: PDN BBS LIST (1 OF 2) 4/3/93 =-=-=-=-PDN BBS List-=-=-=-= This list represents members of the Programmer's Distribution Network who have indicated to me that they will accept file requests for PDN files, or Downloads on the first call, or downloads after a validation program. This list is by no means all-inclusive, but represents only those who have let me know via netmail that they would like to be on the list. See *Note below for FTP access. KEY: Types: HST = USRobotics Courier HST 14.4k V32B = CCITT v.32bis compliant HST+ = USRobotics Courier HST 16.8k CSP = Compucom CSP V32 = CCITT v.32 compliant ZYX = ZyXEL 16.8k v.32bis FQ: U=Unlisted OK, L=only in nodelist DL: Y=on first call, V=after validation, LDV=Long Distance Validation N=n/a PDN: A=all areas, N=Not all areas Hrs: A=anytime but ZMH, or listed times Node: FidoNet Node Number or UL=not in nodelist = *USA* ================================================================ St: Phone: Type: Fq: DL: PDN Hrs: Node: ======================================================================== AL 1-205-666-0932 HST L LDV A 17:00-24:00 1:3625/454 AK 1-501-450-7010 ZYX V32B U Y A A 1:399/11 AZ 1-602-944-0524 V32B U V A A 1:114/161 CA 1-916-334-4470 HST+ V32B U Y A A 1:203/540 CA 1-916-334-4478 HST U Y A A 1:203/541 CA 1-714 939-6401 HST V32B U Y A A 1:103/208 CA 1-310-419-0931 V32B U Y A 03:00-01:00 1:102/531 CO 1-719-380-8813 HST+ V32B U Y A A 1:128/60 CT 1-203-879-7122 V32B U Y A A 1:141/1135 8:909/5(RBBS) DE 1-302-995-6910 2400 U Y N A 1:150/170 GA 1-912-329-8984 V32B L LDV N A 1:3611/15 IL 1-708-680-9420 HST V32b Y Y A A 1:115/858 LA 1-504-386-8827 V32B U Y A A 1:394/7 MA 1-508-250-0187 HST+ V32B U V A A 1:324/287 MA 1-508-250-4672 HST+ V32B U V A A 1:324/288 MA 1-508-256-1222 HST+ V32B U V A A 1:324/291 MA 1-508-250-0135 HST+ V32B U V A A 1:324/292 MS 1-601-467-0801 V32 U Y A A 1:3604/15 NJ 1-908-271-5168 HST V32B U Y A A 1:107/302 NJ 1-908-572-1202 HST V32B U Y A A 1:107/309 NY 1-212-927-4980 HST+ V32B U Y A A 1:278/707 NY 1-315-564-5700 V32B U Y A 03:00-04:00 EST 1:2608/15 NY 1-716-381-8538 HST V32B U V A A 1:2613/210 NY 1-716-898-4366 HST V32B U Y A A 1:260/1 NY 1-914-344-0350 HST V32B U Y A A 1:272/38 NY 1-914-343-7540 V32B U Y A A 1:272/100 NC 1-919-286-7738 HST V32B U V A A 1:3641/1 NC 1-919-286-4542 ZYX V32B U V A A 1:3641/224 NV 1-702-253-6527 HST+ V32B U Y A A 1:209/710 NV 1-702-253-6274 V32 U Y A A 1:209/710 OK 1-918-438-8260 HST+ V32b U Y A A 1:170/403 PA 1-412-244-9416 2400 U N N M-F 23hrs 1:129/124 TX 1-210-653-2115 ZYX V32B U Y N A 1:387/641 TX 1-210-675-4787 V32 U Y A 05:00-02:30 1:387/666 TX 1-512-573-0245 HST V32B U Y A A 1:3802/213 TX 1-512-572-8378 CSP N Y A A UL TX 1-817-483-2283 V32B U Y A A 1:130/403 TX 1-915-595-4914 V.32 U Y A A 1:381/106 WA 1-509-582-9493 HST+ V32B U LDV A A 1:347/10 WY 1-307-686-0940 HST V32B L Y A 00:30-24:00 1:316/16 = *Austria* =========================================================== Vienna 43-1-290-3658 ZYX V32B U Y A A 2:310/24 = *Belgium* ============================================================== Antwerp 32-3-2343790 V32B V42B U Y A A 2:292/855 = *Canada* =============================================================== Sask. 1-306-463-3117 HST+ V32B U Y A A 1:140/53 Sask. 1-306-463-4581 V32B N Y A A UL Sask. 1-306-585-0298 HST Y Y A A 1:140/40 Quebec 1-418-648-9590 HST L V A 6am-3am 1:240/507 Quebec 1-418-648-0691 V32B L V A 6am-3am EDT 1:240/508 =France ================================================================ Wervicq-Sud 33-20392225 HST+ V32B L V A A 2:322/2 Wervicq-Sud 33-20399342 HST+ V32B L V A A 2:322/3 Wervicq-Sud 33-20392236 HST+ V32B L V A A 2:322/4 = Germany ============================================================== Kronberg 49-6173-2544 HST V32B U V A 08:00-18:00 2:249/3 19:00-24:00 MET = Italy ================================================================= Malgesso 39-332-706469 HST+ V32B U Y A A 2:331/106 Malgesso 39-332-706739 HST V32B U Y A A 2:331/117 Malgesso 39-332-706009 ZYX V32B U Y A A 2:331/121 Biandrnno 39-332-767277 HST V32B U Y A A 2:331/110 Biandrnno 39-332-819044 ZYX V32B U Y A A 2:331/118 Biandrnno 39-332-767329 ZYX V32B U Y A A 2:332/122 = *Luxembourg* ========================================================= Strassen +352-316702 ZYX V32B U Y A A 2:270/17 = *Netherlands* ======================================================== Delden 31-5407-64701 HST V32B U Y A 8am-12pm CET 2:283/309 2:283/309 Den Bosh 31-73-222164 HST V32B U Y A 6am-3am CET 2:512/152 Eck & Wiel 31-3449-1909 V21 V22 U Y N 8am-2pm 2:500/137 V32B V42B Groningen 31-50-735035 HST V32B U Y Y 8am-12pm CET 2:512/159 = *Sweden* ============================================================ Lerum 46-302-16565 HST U V A 07:00-23:00 2:203/311 ======================================================================= *Note: PDN Files are available via Anonymous-FTP from ftp.ieee.org (and mirrored to halcyon.com) in the pub/fidonet/pdn directories. IP Address 140.98.1.1 File Arrival Announcement messages are available on Internet via mailing list. To be added to the mailing-list send e-mail to: filebone-request@zeus.ieee.org If you carry the Programmer's Distribution Network and would like to be added to this list, please send netmail to Janis Kracht 1:272/38, <<PRISM BBS (914)344-0350 HST,V32B. For information about the PDN, freq or D/L PDNINFO.ARJ from my system. ' 'Msg #: 547 QUIKBAS Subboard ' From: VICTOR YIU Sent: 04-02-93 23:06 ' To: ALL Rcvd: -NO- ' Re: VERY IMPORTANT MESSAGE! ' 'Hi, All! ========= IMPORTANT ANNOUCEMENT =========> ' ' Finally, PostIt! 6.0 will be posted. I won't repeat the new 'features, but they can be found in PostIt!'s header. ' ' It is =ESSENTIAL= that you capture the next 16 messages. From this 'now on, PostIt!'s scripts will not be able to be decoded by QuickBASIC 'alone. It will require PostIt! 6.0 to extract the file. ' ' The new format is so much more compact -- primarily due to the 'removal of the decoder. It was pretty wasteful to post the decoder 'again and again, with every binary file. That's why it has been 'incorporated into PostIt! 6.0. ' ' You may wonder why this release is 16 messages long. That may sound 'like much, but it isn't! The line length has been shortened to =65= and 'page length to =85=. All that contribute to more line wrapping, thus 'increasing the number of posts. The 'real' file size of PostIt! 6.0 is 'only 1K bigger than 5.1. Why '65'? To make sure all people will 'recieve PostIt! without things being truncated. ' ' I really hope the complete PostIt! package reaches everybody reading 'this echo. I am excited to post my latest additions, so here it is..... ' 'Victor '________O_/________________________| SNIP |______________________\_O_______ ' O \ | HERE | / O 'This file created by PostIt! v6.0. '>>> Start of page 1. ' ╔═══════════════════════════════════════════════════════╗ ' ║ PostIt! THE Binary <-> BASIC Script Creator ║ ' ╚═══════════════════════════════════════════════════════╝ ' * * * ' ╔═══════════════════════════════════════════════════════╗ ' ║ Postit! v6.0 by Rich Geldreich 1992 ║ ' ╟───────────────────────────────────────────────────────╢ ' ║ Decoder further optimizied by Jim Giordano ║ ' ╟───────────────────────────────────────────────────────╢ ' ║ User Interface and Graphical embellishments by ║ ' ║ Mark H Butler & Quinn Tyler Jackson ║ ' ╟───────────────────────────────────────────────────────╢ ' ║ Ability to post and wrap plain code ─- as text! ║ ' ║ Based on MsgSplit by Scott Wunsch and Victor Yiu. ║ ' ╟───────────────────────────────────────────────────────╢ ' ║ And now, with compression and a new script format ║ ' ║ to reduce the echo bandwidth required to post your ║ ' ║ file, from Victor Yiu! ║ ' ╚═══════════════════════════════════════════════════════╝ ' 'Purpose: ' To enable the posting of compressed listings on a text only net. ' This program takes a binary input file and converts it to a series ' of small, postable files which other people can capture and run to ' get the original binary file. ' 'Instructions: ' Just follow the prompts. You give the input & output filenames, ' the page length and the number of lines you want reserved for your ' stuff and it does the rest. If nothing is inputted for a prompt, a ' default value will be used for it instead. ' ' 'Additions by Victor Yiu: ' ' (26 March 1993) ' NEW! Addition of the new high efficiency script format, saving ' 800 bytes over the old format! Still supports the old self- ' extracting model for compatibility. New format allows you to ' run the cut script from the echo without editing! Just paste ' all the pages together and run it through PostIt!. ' Now, all line lengths will remain constant, even with compression. ' It results in less unnecessary carriage returns and `G"' lines! ' After this update, I don't see too many improvements ahead -- it's so ' jam packed with features! ;-) ' Some unnecessary & ancient comments are removed for space efficiency ' The source is also modified so that most lines are less than ' ' (16 March 1993) ' Victor Yiu nominated & appointed the keeper of PostIt! by Zack Jones. ' ' (9 March 1993) ' Version 5.1 speeds the binary decoder up and cleans the PostIt! ' source code enormously. Decompression routine rewritten. ' Message splitter's tab stop expansion is now user modifiable. ' ' (28 February 1993) ' Now, save an average of 10% on posting object files! This version ' includes compression of duplicate characters. Also fixes several ' bugs and quirks (visual & operational), and adds a disk buffer for ' increased conversion speed. The text wrapping problem with ' quotes has also been totally elimintated; now, the comments ' starting later in the line extending past the wrap will not be ' messed up during splitting, as is was before. Twirler was ' optimized/fixed (MsgSplit). Decoder was optimized more, but more ' code had to be added on to handle compression. ' 'Additions by Scott Wunsch: ' (13 February 1993) ' PostIt! is no longer just for binary files! It can be used to post ' BASIC code, and will do so in text format. Code will be word- ' wrapped appropriately, and underscores inserted to allow QB/PDS to ' put it back together again for you. Unlike past code-wrapping ' programs, PostIt! can even handle quoted strings properly. ' 'Additions by Mark Butler: ' (8-30-1992) ' Postit! output filename now defaults to the input filename if none ' is given. If the input filename is 8 characters in length the ' default output filename will be truncated to the first 7 characters ' of the input filename. The default output extension is now "BAS" ' instead of nothing. I also added a little bit of text mode "screen ' magic" to further augment Quinn T. Jackson's copyright screen and ' warning screen additions. Fixed bug from version 2.8 that caused ' succeeding output files after the first one to overwrite the same ' filename due to the filename number suffix not incrementing. I also ' caused the program to skip the opening screens if an input filename ' is entered from the command line when the program is run. (I didn't ' think folks wanted to see those screens *every* time they wanted to ' use PostIt! Sometimes ya just want to get on with it right?) ' (9-1-1992) ' Hardcoded a CHR$(32) (a space character) to the end of each full ' length G-sub data line in the attempt to thwart line truncation in ' transit on the Net. Just a theory that I hope is correct! -> MHB ' 'Additions and Modifications by Quinn Tyler Jackson (August 22, 1992): ' ' Postit! now prints a warning screen, warning users of possible ' abuse of binary-to-text posts. Also, instead of the old '80% DONE' ' meter, this version uses a graphical bar that looks like this: ' ' ▓▓▓▒▒▒▒▒▒▒▒▒▒ (One block=2% completion.) ' ' I have also added a nice starting screen, giving Rich credit where ' it is due! Bells and whistles, boys! ' <qtj> ' 'Note to QBasic users: ' The COMMAND$ function is utilized in this version so if you are ' using QBasic you should delete the lines marked "**** Delete this ' line for QBasic use ******". All such lines *MUST* be deleted or ' REMmed out for this version to work with QBasic. ' 'Note: The decoder outputted with the encoded data has been ' "compressed" in order to squeeze it into 8 lines. Each line of the ' decoder is less that 72 characters, so don't worry if it looks like ' some lines are too long when you load it into QB. When QB expands ' the decoder to make it look "nicer," some lines will look like ' they're too long to put on an echo, even though they aren't. What ' I'm trying to say is: Only post the files outputted by this ' program, don't load them into QB and resave them. ' 'Tech stuff: ' The output files created by this program should be "echo safe". ' The following 64 characters are used to encode the binary file: ' ' abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789() ' ' The script file is checked at runtime to see if all of the encoded ' data is present. Also, a simple checksum is used to inform the ' user if the script file was screwed or not. (The file created is ' not deleted if this occurs, however. If only a few characters are ' garbled, then some of the output file may be still extractable. ' But if the 6-bit output stream falls out of sync, then there's a ' very good chance that the rest of the archive is completly ' unusable.) ' ' If anybody has any suggestions, or finds any bugs in this program, ' then please drop me a message and tell me about it! -Rich Geldreich '******************************************************************** DEFINT A-Z CONST True = -1, False = NOT True CONST frontpage = 0, backpage = 1 '<-- for popping the warning ' screen in and out -> MHB DECLARE SUB CopyrightScreen () DECLARE SUB Delay (Secs!) DECLARE SUB DrawBox (Uprow, Ltcol, Lorow, Rtcol, Solid) DECLARE SUB ExtractFile () DECLARE SUB Initialize () DECLARE SUB GetInformation () DECLARE SUB JustDoIt () DECLARE SUB Linein (LineColor%) DECLARE SUB Lineout (LineColor%) DECLARE SUB MsgSplit (SourceFile$, RealSource$, DestFile$,_ DestExten$, PageLength, LinesOut, LineLength) 'SAW DECLARE SUB PrepareFile () DECLARE SUB PrintDecoder () DECLARE SUB PrintLine (A$) DECLARE SUB PutByte (A) DECLARE SUB PutBytes (A) DECLARE SUB Shadow (Uprow, Ltcol, Lorow, Rtcol) DECLARE SUB ShortCopyright () DECLARE SUB Twirl () DECLARE SUB WarningScreen () DECLARE FUNCTION Analyze (Filename$) DECLARE FUNCTION CheckForFile& () DECLARE FUNCTION Compress$ (A$) DECLARE FUNCTION GetInput$ (Prompt$, MaxLen%) DECLARE FUNCTION Num2Str$ (A) DECLARE FUNCTION ParseFileName$ () DIM SHARED Lines$(1 TO 24), Shift(5), Proplr$ ' global vars. DIM SHARED LinesOut, PageLength, CurrentPage, FileLength DIM SHARED LineLength, BytesOut, TotalLinesOut, NewFileFlag DIM SHARED SourceFile$, DestFile$, DestExten$, RealSource$, ToDo$ DIM SHARED Row, Col, CheckSum, CurrentByte, CurrentBit, Char DIM SHARED Work$, ComprChar$, Qt$, Prefix$, TabStops DIM SHARED WhatFmt$, SmallScript Initialize Good$ = "abcdefghijklmnopqrstuvwxyz" Good$ = Good$ + UCASE$(Good$) + "0123456789#$" LineLength = 65 ' please don't change this for the ' sake of safety GetInformation IF ToDo$ = "E" THEN ExtractFile IF WhatFmt$ = "N" THEN 'Launch code wrapper if wanted MsgSplit SourceFile$, RealSource$, DestFile$,_ DestExten$, PageLength, LinesOut, LineLength END IF T! = TIMER ' start timer PrepareFile ' open file, print header, etc. JustDoIt ' do the binary stuff PrintDecoder ' print decoder, close file T! = TIMER - T! ' stop timer LOCATE Row, Col PRINT " " PRINT PRINT TotalLinesOut; "lines in"; CurrentPage; PRINT "file(s) written." PRINT USING "Elapsed time: ##.# secs."; T! END FUNCTION Analyze (Filename$) OPEN Filename$ FOR BINARY AS #5 Tmp$ = INPUT$(20, #5) FOR A = 1 TO 20 Ch$ = MID$(Tmp$, A, 1) IF Ch$ < " " THEN Analyze = True: EXIT FOR IF Ch$ > "~" THEN HiASCII = HiASCII + 1 NEXT IF HiASCII > 12 THEN Analyze = True CLOSE #5 END FUNCTION FUNCTION CheckForFile& OPEN SourceFile$ FOR BINARY AS #1 A& = LOF(1) IF A& = 0 THEN CLOSE KILL SourceFile$ PRINT " File not found." END IF CheckForFile& = A& END FUNCTION SUB CopyrightScreen Linein 1 COLOR 15, 1 LOCATE 4, 1 PRINT " ▒▒▒▒▒▒▒▒▒▄ "+_ " ▒▒▄" PRINT " ▒▒█▀▀▀▒▒█ "+_ " ▒▒█" PRINT " ▒▒█ ▒▒█ ▒▒▒▒▒▒▄ ▒▒▒▒▒▒▄ ▒▒▒▒▒▒▒▒▄ ▒▒▒▒▄"+_ " ▒▒▒▒▒▒▒▒▄ ▒▒█" PRINT " ▒▒▒▒▒▒▒▒█ ▒▒█▀▒▒█ ▒▒█▀▀▀▀ ▀▀▒▒█▀▀▀ ▒▒█▀ "+_ " ▀▀▒▒█▀▀▀ ▒▒█" PRINT " ▒▒█▀▀▀▀▀▀ ▒▒█ ▒▒█ ▒▒▒▒▒▒▄ ▒▒█ ▒▒█ ▒▒█"+_ " ▒▒█" PRINT " ▒▒█ ▒▒█ ▒▒█ ▀▀▀▒▒█ ▒▒█ ▒▒█ ▒▒█"+_ " ▀▀" PRINT " ▒▒▒▒█ ▒▒▒▒▒▒█ ▒▒▒▒▒▒█ ▒▒█ ▒▒▒▒█ ▒▒█"+_ " ▒▒▄" PRINT " ▀▀▀▀ ▀▀▀▀▀▀ ▀▀▀▀▀▀ ▀▀ ▀▀▀▀ ▀▀"+_ " ▀▀ v6.0" COLOR 14, 1 PRINT " ╥ ╥ ┬ ╥──┐ ─╥─ ╓─╥─┐ ╓─╥─┐ ╥──┐ ╓─╖ ┬ "+_ " ╥─┐ ╥ ┬" PRINT " ║ ║ │ ╟─┬┘ ║ ║ ║ ╟─ ║ ║ │ "+_ " ╟─┴┐ ╙──┤" PRINT " ╙─╨─┘ ╨ ┴─ ─╨─ ╨ ╨ ╨──┘ ╨ ╙─┘ "+_ " ╨──┘ ╙──┘" PRINT " ╥──┐ ─╥─ ╓──┐ ╥ ┬ ╓─── ╥──┐ ╥─ ╓─┐ ╥──┐"+_ " ╥──┐ ─╥─ ╓──┐ ╥ ┬" PRINT " ╟─┬┘ ║ ║ ╟──┤ ║ ┌┐ ╟─ ║ ║ └┐ ╟─┬┘ ╟─"+_ " ║ ║ ╟──┤" PRINT " ╨ ┴─ ─╨─ ╙──┘ ╨ ┴ ╙──┘ ╨──┘ ╨──┘ ╙──┘ ╨ ┴─"+_ " ╨──┘ ─╨─ ╙──┘ ╨ ┴" PRINT COLOR 13, 1 PRINT SPC(22); "Decoder revisions by Jim Giordano." PRINT SPC(19); "Graphical & user interface revisions by" PRINT SPC(20); "Mark H Butler and Quinn Tyler Jackson." PRINT SPC(21); "Text code wrapping by Scott Wunsch." PRINT SPC(16); "Compression & new script format by Victor Yiu." COLOR 15 Solid = False DrawBox 1, 1, 25, 80, Solid COLOR 7 Delay 5 WarningScreen Delay 1 Lineout 1 COLOR 15, 0 CLS PRINT "PostIt! Version 6.0" PRINT END SUB SUB Delay (Secs!) Begin! = TIMER DO LOOP UNTIL ((TIMER - Begin!) >= Secs!) OR (Begin! > TIMER) END SUB SUB DrawBox (Uprow, Ltcol, Lorow, Rtcol, Solid) wide = Rtcol - Ltcol - 1 LOCATE Uprow, Ltcol PRINT CHR$(201); STRING$(wide, CHR$(205)); CHR$(187); FOR I = Uprow + 1 TO Lorow - 1 LOCATE I, Ltcol PRINT CHR$(186); IF Solid THEN PRINT SPACE$(wide); LOCATE I, Rtcol PRINT CHR$(186); NEXT LOCATE Lorow, Ltcol PRINT CHR$(200); STRING$(wide, CHR$(205)); CHR$(188); END SUB SUB ExtractFile SHARED Good$ PRINT PRINT "Examining "; SourceFile$; "..." COLOR 7 CLOSE OPEN SourceFile$ FOR INPUT AS #1 LEN = 4096 ' open file DO IF NOT EOF(1) THEN LINE INPUT #1, A$ ELSE GOTO ErrorReading END IF LOOP WHILE LEFT$(A$, 13) <> "~PostIt! 6.0~" 'search for header NewFile$ = MID$(A$, 14) NxtTilde = INSTR(NewFile$, "~") IF NxtTilde = 0 THEN GOTO ErrorReading NewFile$ = LEFT$(NewFile$, NxtTilde - 1) ' get filename OPEN NewFile$ FOR BINARY AS #2 ' open... PRINT "Loading "; SourceFile$; "..." DO IF EOF(1) THEN GOTO ErrorReading ' end of file already? LINE INPUT #1, A$ ' get a line SELECT CASE LEFT$(A$, 1) CASE "~" IF NOT QuoteOn THEN EXIT DO ' end; quit loop END IF CASE "a" TO "z", "A" TO "Z", "#", "$", "(" TO "9" IF NOT QuoteOn THEN FOR Q = 2 TO 9 ' expand the string Look$ = MID$(ComprChar$, Q - 1, 1) S = 1 DO S = INSTR(S, A$, Look$) IF S THEN A$ = LEFT$(A$, S - 1) + STRING$(Q,_ 97) + MID$(A$, S + 1) END IF LOOP WHILE S NEXT Dat$ = Dat$ + RTRIM$(A$) ' nope, collect dust END IF CASE "'" QuoteOn = NOT QuoteOn CASE ELSE ' just comments or junk END SELECT LOOP Siz = VAL(MID$(A$, 2)) ' extract size of file NxtNum = INSTR(2, A$, "~") ' look 4 next ~ occurence IF NxtNum = 0 THEN GOTO ErrorReading ' none? Error! CheckVal = VAL(MID$(A$, NxtNum + 1)) ' get checkval PRINT "Decoding "; SourceFile$; "..." PRINT STRING$(50, 178); ' print initial bar LOCATE , , 0 DIM P(6) FOR P = 0 TO 6: P(P) = 2 ^ P: NEXT n = Siz k = 255 V! = 50 / n FOR A = 1 TO n ' decode file IF L = 0 THEN GOSUB G L = 6 LOCATE , 1 PRINT STRING$(V! * A, 177); END IF W = T \ P(6 - L) GOSUB G W = W OR T * P(L) L = L - 2 B$ = CHR$(W AND k) PUT 2, , B$ NEXT PRINT PRINT IF (C = CheckVal) AND (LOF(2) = Siz) THEN PRINT NewFile$; " successfully extracted." ELSE PRINT "Bad checksum or incomplete script!" END IF CLOSE END G: I = I + 1: T = INSTR(Good$, MID$(Dat$, I, 1)) - 1 C = (C + T) * 2: C = C \ 256 + (C AND 255) RETURN ErrorReading: CLOSE PRINT "Error reading script." END END SUB SUB GetInformation SourceFile$ = LTRIM$(RTRIM$(COMMAND$)) '**** Remark the above line for QBasic *** IF LEN(SourceFile$) <> 0 THEN ShortCopyright A& = CheckForFile IF A& = 0 THEN END ELSE CopyrightScreen DO SourceFile$ = UCASE$(GetInput$("Input filename"+_ " (text/binary)? ", -1)) IF LEN(SourceFile$) THEN A& = CheckForFile ELSE END END IF LOOP UNTIL A& PRINT END IF A = 8192 ' PostIt! 6.0 script? IF LOF(1) < A THEN A = LOF(1) A$ = INPUT$(A, 1) IF INSTR(A$, "~PostIt! 6.0~") THEN A$ = "" ToDo$ = "E" EXIT SUB ELSE A$ = "" ToDo$ = "M" END IF DefaultFile$ = ParseFileName$ Recommend = Analyze(SourceFile$) COLOR 15 PRINT "I recommend using the "; COLOR 13 IF Recommend THEN PRINT "binary script (Y)"; R$ = "Y" ELSE PRINT "message wrapper (N)"; R$ = "N" END IF COLOR 15 PRINT " on this file." WhatFmt$ = UCASE$(GetInput$("Which format [" + R$ + "]? ", 1)) IF (WhatFmt$ <> "Y") AND (WhatFmt$ <> "N") THEN WhatFmt$ = R$ LOCATE CSRLIN - 1, 19 PRINT WhatFmt$ 'max file size is actually about 24576 bytes '(because 24576*1.33333 is >32767) IF WhatFmt$ = "Y" THEN IF A& > 24550 THEN COLOR 7: PRINT PRINT "Binary file exceeds maximum size of 24K!" END ELSE FileLength = A& END IF A$ = UCASE$(GetInput$("Use condensed script format [Y]? ", 1)) IF A$ <> "N" THEN SmallScript = True A$ = "Y" END IF LOCATE CSRLIN - 1, 34 PRINT A$ ELSE PRINT A$ = "Expand tabs to how many spaces [4]? " TabStops = VAL(GetInput$(A$, 1)) IF TabStops <= 0 THEN TabStops = 4 LOCATE CSRLIN - 1, 36 PRINT TabStops END IF END IF PRINT A$ = "What is the destination prefix (max. 6 chars.) [" DestFile$ = UCASE$(GetInput$(A$ + DefaultFile$ + "]? ", 6)) IF LEN(DestFile$) = 0 THEN DestFile$ = DefaultFile$ LOCATE CSRLIN - 1, 52 + LEN(DefaultFile$) PRINT DefaultFile$ END IF IF SmallScript THEN DExt$ = ".PI6" ELSE DExt$ = ".BAS" END IF DestExten$ = UCASE$(GetInput$("What is the destination extension"+_ " (max. 3 chars.) [" + DExt$ + "]? ", 3)) IF LEN(DestExten$) = 0 THEN DestExten$ = DExt$ LOCATE CSRLIN - 1, 59 PRINT DExt$ ELSEIF INSTR(DestExten$, ".") = 0 THEN DestExten$ = "." + DestExten$ END IF PageLength = VAL(GetInput$("Page length [85]? ", 3)) IF PageLength < 5 THEN PageLength = 85 LOCATE CSRLIN - 1, 19 PRINT "85 " END IF LinesOut$ = GetInput$("Lines to reserve on first message [5]? ",_ 2) LinesOut = VAL(LinesOut$) IF (LEN(LinesOut$) = 0) OR (LinesOut < 0) THEN LinesOut = 5 LOCATE CSRLIN - 1, 40 PRINT "5 " END IF LOCATE , , 0 END SUB ' Yep, the same one I released, except stripped of comments and ' some features. -VY FUNCTION GetInput$ (Prompt$, MaxLen) Null$ = CHR$(0): SpaceBar$ = " " Insrt$ = Null$ + "R": Delete$ = Null$ + "S" LeftK$ = Null$ + "K": RightK$ = Null$ + "M" Home$ = Null$ + "G": End$ = Null$ + "O" IF MaxLen < 1 THEN MaxLen = 80 - LEN(Prompt$) - POS(0) COLOR 14 PRINT Prompt$; StartX = POS(0): Cursor = 1 Insrt = True COLOR 7 DO IF Updt THEN LOCATE , StartX, 0 PRINT OutS$; SpaceBar$; Updt = False END IF LOCATE , Cursor + StartX - 1, 1, (NOT Insrt) * -7, 16 DO: I$ = INKEY$ LOOP UNTIL LEN(I$) IF LEN(I$) = 1 THEN Updt = True SELECT CASE ASC(I$) CASE IS >= 32 IF (NOT Insrt) OR (LEN(OutS$) < MaxLen) THEN IF Cursor > 0 THEN OutS$ = LEFT$(OutS$, Cursor - 1) + I$ +_ MID$(OutS$, Cursor - (NOT Insrt)) ELSE OutS$ = I$ END IF Cursor = Cursor + 1 ELSE Updt = False END IF CASE 8 IF LEN(OutS$) AND (Cursor > 1) THEN OutS$ = LEFT$(OutS$, Cursor - 2) + MID$(OutS$,_ Cursor) Cursor = Cursor - 1 ELSE Updt = False END IF CASE 13 EXIT DO CASE 27 IF LEN(OutS$) > 0 THEN LOCATE , StartX, 0 PRINT SPACE$(LEN(OutS$) + 1); OutS$ = "" Cursor = 1 Updt = False ELSE EXIT DO END IF END SELECT ELSE ' extended ASCII code SELECT CASE I$ CASE LeftK$ IF Cursor > 1 THEN Cursor = Cursor - 1 CASE RightK$ IF Cursor < LEN(OutS$) + 1 THEN Cursor = Cursor + 1 CASE Delete$ IF LEN(OutS$) > 0 AND (Cursor < LEN(OutS$)) THEN OutS$ = LEFT$(OutS$, Cursor - 1) + MID$(OutS$,_ Cursor + 1) Updt = True END IF CASE Home$ Cursor = 1 CASE End$ Cursor = LEN(OutS$) + 1 CASE Insrt$ Insrt = NOT Insrt END SELECT END IF LOOP LOCATE , , 1, 0, 16 PRINT GetInput$ = LTRIM$(RTRIM$(OutS$)) END FUNCTION SUB Initialize FOR DefShift = 0 TO 5 Shift(DefShift) = 2 ^ DefShift NEXT ComprChar$ = "()*+,-./" Proplr$ = CHR$(179) + "/-\" Qt$ = CHR$(34) A$ = " " CurrentPage = 1 Work$ = Prefix$ CurrentBit = 0 Char = 0 LOCATE , , 0 END SUB SUB JustDoIt SEEK #1, 1 LinesOut = LinesOut + 2 ' compensate for header TotalLinesOut = 3 DO CurrentByte = SEEK(1) L& = FileLength - CurrentByte + 1 ' what's left? SELECT CASE L& CASE IS > 4096 Block$ = SPACE$(4096) CASE IS <= 0 EXIT DO CASE ELSE Block$ = SPACE$(L&) ' rest of it END SELECT GET #1, , Block$ FOR Pointr = 1 TO LEN(Block$) IF (Pointr AND 15) = 0 THEN CurrentByte = CurrentByte + 16 Twirl END IF PutBytes ASC(MID$(Block$, Pointr, 1)) NEXT LOOP 'flush the input buffer if it contains any bits IF CurrentBit > 0 THEN CurrentBit = -1: PutByte Char IF LEN(Work$) > 2 THEN IF SmallScript THEN PrintLine Work$ ELSE 'flush the line buffer if it contains any characters 'Add a CHR$(34) to it just in case a mail reader decides 'to add some extra spaces to the end... PrintLine Work$ + CHR$(34) END IF END IF END SUB SUB Linein (LineColor) '*** By Mark H Butler Lines$(2) = SPACE$(39) + "■" + SPACE$(2) Lines$(1) = SPACE$(39) + "." + SPACE$(2) Lines$(23) = STRING$(80, "─") Sp = 39 Ln = 0 FOR I = 2 TO 21 Lines$(I) = SPACE$(Sp) + STRING$(Ln, "─") + SPACE$(2) Sp = Sp - 2 Ln = Ln + 4 NEXT COLOR LineColor, 0 FOR I = 1 TO 23 LOCATE 13, 1 PRINT Lines$(I); Delay .03 NEXT COLOR 15, LineColor X = 12 y = 13 FOR I = 1 TO 13 LOCATE y, 1 PRINT STRING$(80, " "); LOCATE X, 1 PRINT STRING$(80, " "); DrawBox X, 1, y, 80, -1 Delay .03 IF X > 1 THEN X = X - 1 y = y + 1 NEXT END SUB SUB Lineout (LineColor) '*** By Mark H Butler Lines$(1) = STRING$(80, "─") Sp = 2 Ln = 76 FOR I = 2 TO 21 Lines$(I) = SPACE$(Sp) + STRING$(Ln, "─") + SPACE$(2) Sp = Sp + 2 Ln = Ln - 4 NEXT Lines$(22) = SPACE$(39) + "■" + SPACE$(2) Lines$(23) = SPACE$(39) + "." + SPACE$(2) COLOR 0, 0 X = 1 y = 25 FOR I = 1 TO 12 LOCATE y, 1 PRINT STRING$(80, CHR$(32)); LOCATE X, 1 PRINT STRING$(80, CHR$(32)); Delay .03 X = X + 1 y = y - 1 NEXT COLOR LineColor, 0 FOR I = 1 TO 23 LOCATE 13, 1: PRINT Lines$(I); Delay .03 NEXT COLOR 7 CLS END SUB SUB MsgSplit (Filename$, TheName$, OutN$, Ext$, LPP, Reserve,_ LineLength) CLOSE OPEN Filename$ FOR INPUT AS #1 Tab$ = CHR$(9): TabSub$ = SPACE$(TabStops) LinesOut = Reserve + 1 FileOutNum = 1: OnMsgNumber = 1 LPP = LPP - 4 ' lines per page Base$ = LEFT$(OutN$, 6) Ext$ = RIGHT$(Ext$, 3) COLOR 7, 0 PRINT DO OutN$ = Base$ + Num2Str$(FileOutNum) IF Row THEN LOCATE Row, Col: PRINT " " PRINT "Now writing: " + OutN$ + "." + Ext$ + " "; Row = CSRLIN: Col = POS(0) OPEN OutN$ + "." + Ext$ FOR OUTPUT AS #2 IF OnMsgNumber > 1 THEN PRINT #2, "'>>> Start of page"; STR$(OnMsgNumber); "." PRINT #2, ELSE GOSUB Snip PRINT #2, "'This file created by PostIt! v6.0." PRINT #2, "'>>> Start of page"; STR$(OnMsgNumber); "." PRINT #2, END IF TooLong = False FOR Trans = LinesOut TO LPP Percent = (100& * SEEK(1)) \ LOF(1) Twirler$ = MID$("|/─\", (Percent AND 3) + 1, 1) LOCATE Row, Col: PRINT USING "! ###%"; Twirler$; Percent; IF NOT EOF(1) THEN IF Trans = LinesOut THEN DO: LINE INPUT #1, Buf$ LOOP WHILE LEN(Buf$) = 0 ELSE LINE INPUT #1, Buf$ Buf$ = RTRIM$(Buf$) END IF Tb = INSTR(Buf$, Tab$) 'remove those dang chr$(8)s ' (tabs) IF Tb THEN DO Buf$ = LEFT$(Buf$, Tb - 1) + TabSub$ +_ MID$(Buf$, Tb + 1) Tb = INSTR(Tb, Buf$, Tab$) LOOP WHILE Tb END IF Wrapping: IF (LEN(Buf$) > LineLength) AND (LEFT$(Buf$, 1) <>_ "'") THEN Trans = Trans + 1 CommentOn = False FOR A = LineLength TO 40 STEP -1 IF MID$(Buf$, A, 1) = " " THEN WrapPoint = A EXIT FOR END IF NEXT IF WrapPoint = 0 THEN WrapPoint = LineLength QuotesOn = False FOR A = 1 TO WrapPoint Temp$ = MID$(Buf$, A, 1) IF Temp$ = Qt$ THEN QuotesOn = NOT QuotesOn ELSEIF NOT QuotesOn THEN IF (Temp$ = "'") OR (UCASE$(MID$(Buf$,_ A, 4)) = "REM ") THEN CommentOn = True EXIT FOR END IF END IF NEXT Long$ = Buf$ IF CommentOn THEN Buf$ = LEFT$(Buf$, WrapPoint - 1) ELSE IF QuotesOn THEN Buf$ = LEFT$(Buf$, WrapPoint - 1) + Qt$_ + "+_" ELSE Buf$ = LEFT$(Buf$, WrapPoint - 1) + "_" END IF END IF IF NOT ((Trans = LPP) AND LEN(Buf$) = 0) THEN PRINT #2, Buf$ END IF Buf$ = MID$(Long$, WrapPoint) IF CommentOn THEN Buf$ = "'" + Buf$ IF QuotesOn THEN Buf$ = Qt$ + Buf$ GOTO Wrapping END IF IF NOT ((Trans = LPP) AND LEN(Buf$) = 0) THEN PRINT #2, Buf$ END IF END IF NEXT IF NOT EOF(1) THEN PRINT #2, PRINT #2, "'>>> Continued on page"; OnMsgNumber + 1 ELSE PRINT #2, GOSUB Snip PRINT #2, END IF CLOSE #2 IF NOT EOF(1) THEN OnMsgNumber = OnMsgNumber + 1 FileOutNum = FileOutNum + 1 LinesOut = 1 END IF LOOP UNTIL EOF(1) CLOSE LOCATE Row, Col PRINT " " PRINT PRINT "Complete!" END Snip: PRINT #2, "'________O_/________________________| SNIP"+_ " |______________________\_O_______" PRINT #2, "' O \ | HERE | "+_ " / O" RETURN END SUB 'Converts a number to a string lacking a leading space. FUNCTION Num2Str$ (A) Num2Str$ = MID$(STR$(A), 2) END FUNCTION FUNCTION ParseFileName$ 'Get the source filename without the drive & path FOR S = LEN(SourceFile$) TO 1 STEP -1 IF INSTR("\:", MID$(SourceFile$, S, 1)) THEN EXIT FOR NEXT RealSource$ = MID$(SourceFile$, S + 1) 'Get destination prefix & extenstion. Ext = INSTR(RealSource$, ".") IF Ext <> 0 THEN DestTemp$ = LEFT$(RealSource$, Ext - 1) ELSE DestTemp$ = RealSource$ END IF ParseFileName = UCASE$(LEFT$(DestTemp$, 7)) END FUNCTION SUB PrepareFile F$ = UCASE$(DestFile$ + Num2Str$(CurrentPage) + DestExten$) COLOR 7: PRINT PRINT "Now writing: "; F$; " "; Row = CSRLIN: Col = POS(0) 'use 8k output buffer for a little speed OPEN F$ FOR OUTPUT AS #2 LEN = 8192 IF SmallScript THEN PRINT #2, "~PostIt! 6.0~"; RealSource$; "~"; "Script starts" Prefix$ = "" ELSE 'Print the first 3 lines of the decoder. ' Shaved several bytes... -VY PRINT #2, "CLS:?STRING$(50,178):DEFINT A-Z 'Created by PostIt!"+_ " 6.0" PRINT #2, "FOR A=0 TO 6:P(A)=2^A:NEXT:OPEN "; Qt$; "B"; Qt$;_ ",1,"; Qt$; RealSource$ PRINT #2, "T$="; Qt$; "abcdefghijklmnopqrstuvwxyz"; Qt$;_ ":T$=T$+UCASE$(T$)+"; Qt$; "0123456789#$" Prefix$ = "G" + Qt$ Work$ = Prefix$ END IF END SUB SUB PrintDecoder IF SmallScript THEN PrintLine "~" + Num2Str$(FileLength) + "~" +_ Num2Str$(CheckSum) + "~" + "End" ELSE 'Main decoder originally reduced from 8 lines to 6 lines by Jim Giordano 'Thanks Jim! 'Slight modifications to the 6 line decoder by Rich Geldreich 'More modifications to the decoder to implement compressed code, ' increased to ~7.2 lines by Victor Yiu 'Modified again to increase speed, but at the slight expense of ' size (3/9/93) -VY PrintLine "N=" + Num2Str$(FileLength) + ":K=255:IF LEN(C$)<>" +_ Num2Str$(BytesOut) + " THEN ?" + Qt$ + "Bad script!" + Qt$ +_ ":END" PrintLine "FOR A=1 TO N:LOCATE 1:?STRING$(50/N*A,177):IF L=0"+_ " THEN GOSUB G:L=6" PrintLine "W=T\P(6-L):GOSUB G:W=W OR T*P(L):L=L-2:B$=CHR$(W AND"+_ " K):PUT 1,,B$:NEXT" PrintLine "?:IF C=" + Num2Str$(CheckSum) + " THEN ?" + Qt$ +_ "Ok" + Qt$ + ":END ELSE ?" + Qt$ + "Bad checksum!" + Qt$ +_ ":END" PrintLine "G:I=I+1:T=INSTR(T$,MID$(C$,I,1))-1:C=(C+T)*2:C=C"+_ "\256+(C AND 255):RETURN" PrintLine "SUB G(A$):SHARED C$:FOR Q=2 TO"+_ " 9:DO:S=INSTR(A$,CHR$(Q+38))" PrintLine "IF S THEN A$=LEFT$(A$,S-1)+STRING$(Q,97)+MID$(A$,S+1)" PrintLine "LOOP WHILE S:NEXT:C$=C$+A$:END SUB" END IF CLOSE END SUB 'Outputs one line to the output file, and opens another output file 'if the page length is exceeded. SUB PrintLine (A$) IF NewFileFlag THEN LOCATE Row, Col PRINT " " NewFileFlag = False CurrentPage = CurrentPage + 1 '<-- switched these 2 lines B$ = Num2Str$(CurrentPage) '--> MHB PRINT #2, "'>> Continued on pg. "; B$ CLOSE #2 F$ = UCASE$(DestFile$ + B$ + DestExten$) PRINT "Now writing: "; F$; " "; Row = CSRLIN: Col = POS(0) OPEN F$ FOR OUTPUT AS #2 LEN = 8192 PRINT #2, "'>> Start: pg. "; B$ LinesOut = 1 END IF TotalLinesOut = TotalLinesOut + 1 PRINT #2, A$ ' Originally, Mark hardcoded a space after each line, but I ' had to remove it to make compression work properly... -VY LinesOut = LinesOut + 1 IF LinesOut >= PageLength THEN NewFileFlag = True END SUB 'Adds a character to the output string. SUB PutByte (A) SHARED Good$ STATIC ALength IF CurrentBit < 0 THEN LastOne = True BytesOut = BytesOut + 1 'calculate a checksum on the encoded data stream CheckSum = (CheckSum + A) * 2 CheckSum = CheckSum \ 256 + (CheckSum AND 255) IF (A = 0) AND (LastOne = False) THEN IF ALength = 9 THEN ALength = 1 Work$ = Work$ + "/" ELSE ALength = ALength + 1 END IF ELSE SELECT CASE ALength CASE 0 'translate the output character into something safe Work$ = Work$ + MID$(Good$, A + 1, 1) CASE 1 Work$ = Work$ + "a" + MID$(Good$, A + 1, 1) ALength = 0 CASE ELSE Work$ = Work$ + MID$(ComprChar$, ALength - 1, 1) +_ MID$(Good$, A + 1, 1) ALength = 0 END SELECT END IF IF LEN(Work$) >= LineLength THEN IF LEN(Work$) = LineLength THEN PrintLine Work$ Work$ = Prefix$ ELSE PrintLine LEFT$(Work$, LineLength) Work$ = Prefix$ + MID$(Work$, LineLength + 1) END IF END IF END SUB SUB PutBytes (A) 'shift the 8 bit character into the work buffer Char = Char + A * Shift(CurrentBit) 'we've got 8 more bits now CurrentBit = CurrentBit + 8 'write the 6 bit codes now DO WHILE CurrentBit > 5 'have at least 6 bits left? PutByte (Char AND 63) 'write out the first 6 bits Char = Char \ 64 'shift it right 6 places CurrentBit = CurrentBit - 6 '6 bits less now LOOP END SUB SUB Shadow (Uprow, Ltcol, Lorow, Rtcol) STATIC '*** Transparent Shadow routine for use with the '*** "Drawbox" SUB program by Mark H Butler DEF SEG = &H40 equip = PEEK(&H10) IF (equip AND 48) = 48 THEN EXIT SUB '*** no use in doing it if it's mono, right? ELSE DEF SEG = &HB800 END IF '****** use the given box dimensions to POKE a *********** '****** "shadow" on the right side and bottom edge ******* attr = 8 FOR Row = Uprow + 1 TO Lorow + 1 '***** right edge ' locations.*** FOR Col = Rtcol + 1 TO Rtcol + 2'***** make it 2 chars ' wide.*** offset = (Row - 1) * 160 + (Col - 1) * 2 + 1 POKE offset, attr NEXT NEXT Row = Lorow + 1 '***** now POKE along the ' ***** FOR Col = Ltcol + 2 TO Rtcol + 2 '***** bottom edge ' ************ offset = (Row - 1) * 160 + (Col - 1) * 2 + 1 POKE offset, attr NEXT DEF SEG END SUB SUB ShortCopyright COLOR 14, 0 CLS PRINT " PostIt! Version 6.0" PRINT COLOR 11 PRINT " Freeware by Rich Geldreich, 1992-1993." PRINT " Decoder modifications by Jim Giordano." PRINT " User interface and graphics by " PRINT " Mark H Butler and Quinn Tyler Jackson." PRINT " Text code wrapping by Scott Wunsch." PRINT " Compression & new script format by Victor Yiu." PRINT COLOR 7 END SUB SUB Twirl STATIC LOCATE Row, Col PRINT MID$(Proplr$, Turn + 1, 1); Turn = (Turn + 1) AND 3 IF Turn = 0 THEN PRINT USING " ###%"; 100& * CurrentByte \ FileLength; END IF END SUB SUB WarningScreen ' I felt this screen was appropriate, since some users have ' abused this wonderful utility! Shame.... <qtj> '---- ' Unfortunately Quinn old friend I think that has proved to be ' too true in some cases ...but... we *can* make it look as ' friendly as possible with a little text mode window magic `eh? ' --> MHB ;^] PCOPY frontpage, backpage COLOR 14, 6 DrawBox 3, 8, 22, 72, True Shadow 3, 8, 22, 72 LOCATE 4, 11: PRINT "NOTE:" LOCATE , 10: PRINT "Some echo participants feel that posting"+_ " binary files in text" LOCATE , 10: PRINT "format leads to anarchy. Postit!, in all"+_ " of its versions is" LOCATE , 10: PRINT "a powerful tool for exchanging information"+_ " over networks such" LOCATE , 10: PRINT "as Fidonet. Before you use this software to"+_ " post anything in" LOCATE , 10: PRINT "any network's echo areas, consider these"+_ " points:" PRINT LOCATE , 10: PRINT "1) Only users with Microsoft's QBASIC or "+_ " QuickBASIC will be" LOCATE , 10: PRINT " able to convert the files back into their"+_ " binary format." PRINT LOCATE , 10: PRINT "2) Binary files that are converted to text"+_ " should be ON TOPIC" LOCATE , 10: PRINT " in order that users of the particular"+_ " echo will benefit" LOCATE , 10: PRINT " from the post. For example: it would not"+_ " be appropriate at" LOCATE , 10: PRINT " all to post an executable file without"+_ " it's corresponding" LOCATE , 10: PRINT " source code in the Fidonet QUIK_BAS echo." PRINT LOCATE , 10: PRINT " This of course only applies to the binary"+_ " posting portion" LOCATE , 10: PRINT " of PostIt!. The code wrapper is much less"+_ " controversial :)." Delay 5 COLOR 11, 1 LOCATE 24, 20: PRINT "(Hit any key to continue with Postit!)"; DO UNTIL LEN(INKEY$): LOOP PCOPY backpage, frontpage END SUB ' Msg #: 651 QUIKBAS Subboard From: TIM BENNETT Sent: 04-05-93 10:17 To: ALL Rcvd: -NO- Re: A USEFUL FUNCTION DECLARE FUNCTION monstring$ (cash AS SINGLE, pad%) ' This function takes a number up to 99999.99 and returns ' a string in the form of -Ninety Nine Thousand Nine Hundred Ninety Nine ' ' Dollars and 99/100. If pad% is TRUE then the ' string is centered in a string of astricks and will be 72 ' characters long. Please don't make fun of my variable names, I just threw ' this together because I needed it at the time ' You are free to use or modify this in any way you wish. ' Lines with the underscore character should be joined with the one below. DEFSNG A-Z FUNCTION monstring$ (cash AS SINGLE, pad%) IF cash < 0 THEN monstring$ = "" EXIT FUNCTION endif DIM one$(10), ten$(9), teen$(9) one$(0) = "": one$(1) = "One ": one$(2) = "Two ": one$(3) = "Three " one$(4) = "Four ": one$(5) = "Five "6: one$(6) = "Six ": one$(7) = "Seven " one$(8) = "Eight ": one$(9) = "Nine ": one$(10) = "Ten " ten$(1) = "Ten ": ten$(2) = "Twenty ": ten$(3) = "Thirty ": ten$(4) = "Forty " ten$(5) = "Fifty ": ten$(6) = "Sixty ": ten$(7) = "Seventy ": ten$(8) = "Eighty ":ten$(9) = "Ninety " teen$(1) = "Eleven ": teen$(2) = "Twelve ": teen$(3) = "Thirteen " teen$(4) = "Fourteen ": teen$(5) = "Fifteen ": teen$(6) = "Sixteen " teen$(7) = "Seventeen ": teen$(8) = "Eighteen ": teen$(9) = "Nineteen " cccash$ = LTRIM$(STR$(cash)) ll! = LEN(cccash$) lw! = INSTR(cccash$, ".") IF ll! - lw! < 2 THEN cccash$ = cccash$ + "0" IF lw! = 0 THEN cccash$ = cccash$ + ".00": lw! = ll! ELSE lw! = lw! - 1 END IF IF lw! > 5 THEN monstring$ = STRING$(72, 32) EXIT FUNCTION END IF ccccash$ = LEFT$(cccash$, lw!) ccash! = VAL(LEFT$(cccash$, lw!)) SELECT CASE lw! CASE 1 temp$ = one$(ccash!) CASE 2 SELECT CASE ccash! CASE 11 TO 19 temp$ = teen$(ccash! - 10) CASE 10, 20, 30, 40, 50, 60, 70, 80, 90 temp$ = ten$(ccash! \ 10) CASE ELSE temp$ = ten$(ccash! \ 10) + one$(VAL(RIGHT$(STR$(ccash!),1))) END SELECT CASE 3 SELECT CASE ccash! CASE 100, 200, 300, 400, 500, 600, 700, 800, 900 temp$ = one$(ccash! \ 100) + "Hundred " CASE ELSE temp$ = one$(ccash! \ 100) + "Hundred " crash! = VAL(RIGHT$(ccccash$, 2)) SELECT CASE crash! CASE 0 TO 10 temp$ = temp$ + one$(crash!) CASE 11 TO 19 temp$ = teen$(crash! - 10) CASE 10, 20, 30, 40, 50, 60, 70, 80, 90 temp$ = temp$ + ten$(crash! \ 10) CASE ELSE temp$ = temp$ + ten$(crash! \ 10) + one$(VAL_ (RIGHT$(STR$(crash!), 1))) END SELECT END SELECT CASE 4 SELECT CASE ccash! CASE 1000, 2000, 3000, 4000, 5000, 6000, 7000, 8000, 9000 temp$ = one$(ccash! \ 1000) + "Thousand " CASE 1100 TO 1999 temp$ = teen$(ccash! \ 100 - 10) + "Hundred " crash! = VAL(RIGHT$(ccccash$, 2)) SELECT CASE crash! CASE 0 TO 10 temp$ = temp$ + one$(crash!) CASE 11 TO 19 temp$ = teen$(crash! - 10) CASE 10, 20, 30, 40, 50, 60, 70, 80, 90 temp$ = temp$ + ten$(crash! \ 10) CASE ELSE temp$ = temp$ + ten$(crash! \ 10) + one$(VAL_ (RIGHT$(STR$(crash!), 1))) END SELECT CASE 2001 TO 9999 part1 = VAL(LEFT$(ccccash$, 2)) crash! = VAL(RIGHT$(ccccash$, 2)) SELECT CASE part1 CASE 20, 30, 40, 50, 60, 70, 80, 90 temp$ = one$(part1 \ 10) + "Thousand " CASE ELSE temp$ = ten$(part1 \ 10) + one$(VAL(MID$(_ ccccash$, 2, 1))) + "Hundred " END SELECT SELECT CASE crash! CASE 0 TO 10 temp$ = temp$ + one$(crash!) CASE 11 TO 19 temp$ = teen$(crash! - 10) CASE 10, 20, 30, 40, 50, 60, 70, 80, 90 temp$ = temp$ + ten$(crash! \ 10) CASE ELSE temp$ = temp$ + ten$(crash! \ 10) + one$(VAL_ (RIGHT$(STR$(crash!), 1))) END SELECT CASE ELSE END SELECT CASE 5 part1 = VAL(LEFT$(ccccash$, 2)) part2 = VAL(MID$(ccccash$, 3, 1)) crash! = VAL(RIGHT$(ccccash$, 2)) SELECT CASE part1 CASE 10, 20, 30, 40, 50, 60, 70, 80, 90 temp$ = ten$(part1 \ 10) + "Thousand " CASE 11 TO 19 temp$ = teen$(part1 - 10) + "Thousand " CASE ELSE temp$ = ten$(part1 \ 10) + one$(VAL_ (RIGHT$(STR$(part1), 1))) + "Thousand " END SELECT SELECT CASE part2 CASE 0 temp$ = temp$ + "" CASE 1 TO 9 temp$ = temp$ + one$(part2) + "Hundred " CASE ELSE END SELECT SELECT CASE crash! CASE 0 TO 10 temp$ = temp$ + one$(crash!) CASE 11 TO 19 temp$ = temp$ + teen$(crash! - 10) CASE 10, 20, 30, 40, 50, 60, 70, 80, 90 temp$ = temp$ + ten$(crash! \ 10) CASE ELSE temp$ = temp$ + ten$(crash! \ 10) + one$(VAL_ (RIGHT$(STR$(crash!), 1))) END SELECT CASE ELSE END SELECT IF temp$ = "One " THEN ext$ = "" ELSE ext$ = "s" IF temp$ = "" THEN temp$ = "Zero ": ext$ = "s" temp$ = temp$ + "Dollar" + ext$ + " and " + RIGHT$(cccash$, 2) + "/100" zz% = LEN(temp$) zzy% = zz% \ 2 zzx% = zz% - zzy% IF pad% <> 0 THEN pad$ = STRING$(72, "*") FOR x = 2 TO 72 STEP 4 MID$(pad$, x, 2) = " " NEXT x MID$(pad$, 36 - zzy%, zz%) = temp$ monstring$ = pad$ ELSE monstring$ = temp$ END IF END FUNCTION ' Msg #: 772 QUIKBAS Subboard From: EARL MONTGOMERY Sent: 04-06-93 21:52 To: FRED DISANO Rcvd: -NO- Re: ROTATE PALETTES (COLORS) 'Fred, here is something that should get you started. If you get 'a Plasma type program written please post it. I would love to 'see it! 'Remarks: The first out sets up the VGA Video to read the color 'value RGB from color 2. These are stored in variables R1,R2 'and R3. 'The next set of OUTS puts the RGB values from color 2 into 'Color 1. 'The two LINE statements proves it works. I am sure you can 'take it from here and accomplish what you want to do. 'Good Luck 'Earl DEFINT A-Z SCREEN 13 LINE (0, 10)-(100, 10), 1 'COLOR 1 LOCATE 2, 20: PRINT "Color 1" C = 1: D = C + 1 sleep(5) 'Needed to let you see the change that occurs. OUT &H3C7, D 'D starts out as color 2 r1 = INP(&H3C9) r2 = INP(&H3C9) r3 = INP(&H3C9) OUT &H3C8, C 'C starts out as color 1 OUT &H3C9, r1 OUT &H3C9, r2 OUT &H3C9, r3 'At this point Color 1 becomes Color 2 LINE (0, 42)-(100, 42), 2 LOCATE 6, 20: PRINT "Color 2" DO LOOP ' I hope I got this right! I'm dead tired and going to bed! 'Fred, if you have a copy of my VGACLIP TSR, use it to capture 'a plasma screen (320*200*256) 'Change the capture file name if necessary to VGASCR02.cap 'Then put it in the QB directory and run this program 'This is NOT repeat NOT what you want to do but it might 'give you some ideas. Play around with the variables and 'see what you come up with. SCREEN 0: CLS : RANDOMIZE TIMER DEFINT A-Z N$ = "VGASCR02.cap" SCREEN 13 OUT &H3C8, 0 FOR x = 0 TO 767 OUT &H3C9, 0 NEXT DEF SEG = &HA000 BLOAD N$, 0 DEF SEG = &HA000 + 4000 OUT &H3C8, 0 FOR x = 0 TO 767 P = PEEK(x) OUT &H3C9, P NEXT begin: r1 = 1: r2 = 1: r3 = 1 'Change these around! FOR x = 255 TO 1 STEP -1 'Change this loop around! r1 = r1 + RND * 1 'Change the rnd(s) around! r2 = r2 + RND * 2 r3 = r3 + RND * 3 OUT &H3C8, x OUT &H3C9, r1 FOR delay = 0 TO 1500: NEXT 'Change the delays to best suit your 'system OUT &H3C9, r2 FOR delay = 0 TO 1500: NEXT OUT &H3C9, r3 NEXT GOTO begin DO LOOP ' Msg #: 874 QUIKBAS Subboard From: DOUGLAS LUSHER Sent: 04-08-93 09:28 To: TOM CARROLL Rcvd: -NO- Re: UNIX TIMESTAMP TC>Sure, and I'd also like to know if you can figure the day of the week by TC>doing this: TC>WeekDay = TotalDays& MOD 7 TC>SELECT CASE WeekDay TC> CASE 0: Today$ = "Thursday" TC> CASE 1: Today$ = "Wednesday" TC> CASE 2: Today$ = "Tuesday" TC> CASE 3: Today$ = "Monday" TC> CASE 4: Today$ = "Sunday" TC> CASE 5: Today$ = "Saturday" TC> CASE 6: Today$ = "Friday" TC>END SELECT Sorry, I can't help you with your question about the UNIX time-stamp, but here's code to figure the day of the week: FUNCTION DOW% (InDate$) 'returns a value representing the day of the week (0 = Saturday, 1 = Sunday, '2 = Monday, etc) for the date string supplied in the form "MM-DD-YYYY" Month% = (ASC(MID$(InDate$, 1)) - 48) * 10 Month% = Month% + (ASC(MID$(InDate$, 2)) - 48) Day% = (ASC(MID$(InDate$, 4)) - 48) * 10 Day% = Day% + (ASC(MID$(InDate$, 5)) - 48) Year% = (ASC(MID$(InDate$, 7)) - 48) * 1000 Year% = Year% + (ASC(MID$(InDate$, 8)) - 48) * 100 Year% = Year% + (ASC(MID$(InDate$, 9)) - 48) * 10 Year% = Year% + (ASC(MID$(InDate$, 10)) - 48) Year% = Year% + (Month% < 3) Temp& = (Year% * 365&) + (Year% \ 4) - (Year% \ 100) + (Year% \ 400) SELECT CASE Month% CASE 1: Temp& = Temp& + 365 CASE 2: Temp& = Temp& + 396 CASE 3: Temp& = Temp& + 59 CASE 4: Temp& = Temp& + 90 CASE 5: Temp& = Temp& + 120 CASE 6: Temp& = Temp& + 151 CASE 7: Temp& = Temp& + 181 CASE 8: Temp& = Temp& + 212 CASE 9: Temp& = Temp& + 243 CASE 10: Temp& = Temp& + 273 CASE 11: Temp& = Temp& + 304 CASE 12: Temp& = Temp& + 334 END SELECT DOW% = (Temp& + Day%) MOD 7 END FUNCTION ' Msg #: 875 QUIKBAS Subboard From: KEITH WATKINS Sent: 04-08-93 11:39 To: ARTHUR SHIPKOWSKI Rcvd: -NO- Re: C TO BASIC CLS:?STRING$(50,178):DEFINT A-Z 'Created by PostIt! 6.0 FOR A=0 TO 6:P(A)=2^A:NEXT:OPEN "B",1,"CSTUFF.ZIP T$="abcdefghijklmnopqrstuvwxyz":T$=T$+UCASE$(T$)+"0123456789#$ G"qT0aeO*GbaqSJvCrKedGBbC*cf(Wb*d9etUq0td1GabiXiuuHn3GwIAUnpfyGet G"quX2B59fAzz7BVlidRClliPlAg#V7Bb5CPRCR7yPBDIEpxq62YwwYe8Q6f17Zww G"6csYgw6gwqAw5#22cYPM2Z62WYwqo23Yw2wg13P9TUX6DAsEpxx2qfsfITL3Yzy G"LXibzANZ2S2JR5DyUwlh6B6RDlz8UBhO11P49Bnt172sx7W9szDBRtXUya$bPmM G"E$w5qExSP5ETCZJZZ2W0L7wWtPWSX9D1DDplAiVdL9HNU5foh1rjCddqv$Dxg41 G"UnnaDo3uypNkOhgM1OKkGVzJ6HVUUb5fB1ePAq751sxen7UmWAlP6#9zbPCK699 G"JgPUzlzeQKmhRmY3nhP91XXimNxgXherFoJ5KSIvotZxYEQHZ8piBBAaZMB1G8o G"7VDtss2w4ONNuUhJ1R2vj9dtu7SW9f57YSNR5UmsDDPZBwNx6wgLvVVeQrncG4a G"7aTdTs7MRUB7BC6j8k9TCjtxjsId5XD9YINGqDwS9wD2Xqib5Ebjic#FPkIcSGj G"rHGx1CX7A2MNIuRYx0$A9tUVCedYDWFdyYEcYtkZtCgmo3dYy6I5ql0ycYwWCxM G"Ueg4bezbZybh8yMgimdtYkJCJx60Fji6pqDk9xM32kM0QbjB#RXFQ#ZCcJ4v0B8 G"89oS7a6DF3XxgMJW8YIPf7wUycdfzIZcXpG1HnnRXdNc35MS9ljJ5n3mg5pLy8M G"PgBnrpb5rY$fB7BnMZSRSWPq66QNYq2lBAYtR32vPlh6tzcUHgewfrWvO$FrYvP G"Lri0JdibgldAov#f73KHziTSzw21JKbIwgew8nzUAywgXrAFFGLn9Enlde5BmcJ G"EUXqziTSqXQ0D0L1T0z8IOD6KgA4SmGPmzH0Xb72Nri1Ynm2f0UEvBObb3TYU89 G"L7MDbCww8iCQn0wgvOtSSjKaYVfUJLnidHLPUE1P#xqKQeLEojBiVkEtNePtgyb G"kCp1YqGxRh7AwgeRlC0Udcz3Pl331nmxHm4gliKfGzSqkl8Xql1YXkgHH4ndS6d G"duLyzGuPhklZg1P275lfldHM5UToyMvsnuPy8LRGhw7SYwLjwsdPMrLLQyX9g8V G"S#slvSESWrPB7#f9KvDS2X2OexfDKrJJCJMNJXM$CoM$C4CCA1CoMWq#fPAthgD G"L1u10XkNZUJb5rc6BZoshcevNw9WzBXdbRdbvBd7#oS#GYu3kkKvCsDEkCHwyYS G"LYYSfGZ9DBYLwrgjP35XNxl3DunbBSNJh1L7edYfNjToL5oQgrBQEJ1GFgo3m3S G"cIxD075QJfxOGmmGXazqb7fIWXXT6i3VrxTQMGYbciJAmusHTDbYqk4dzDmG2E6 G"A26Oa#nz2ADkIAqrXhidSLHwALMnBazKOOS4PazGMqoqgJ7ql1KI7qq3II7qdTk G"wxw#bhwvZAGXVRXDqSm4ov9GXTxP7IAWPT32bnqhR7r1Kjy78eezulXobLLmgOP G"obKPtvPw1I2JRhIK2gMvsHBwZ2c50Yzs1nQ0x2yYe0$DDedZiX#TFb59DNJ2vd0 G"icE70Ns1Ia50z5wTMjugHc2xw0B30JxCZk8WGnn7QDEk$rJU6U5wS4QdLgo8yhl G"Mybzm3XWYXilxYVxBAHte#Co#4W9W7ZjcR6hNsC1ifviY4Q#zofE3SJWq#AMADX G"7Jf2fRD$Mx71zeWRGI1075G#GCkPPDdmPqD0UmbLiRe5YvkzXooZzkAK4UAmayf G"ByvlljcmkSSq6ragf3vltmFeZJemgVDOVMkVp07Oeg18mhmieNJfK7LyzPGBqNM G"orWh7r4eVLwf6wrxz8Hd0FyGJ9nnOyfPfnOePXdT8B2p65$TqEzx6geyl7a3ipM G"qVEe2WRehL98ykdFQmjSDAu8DB64IhnSi0ZbhrGaBWaTriu5ILeUKPVWeJdCHsf G"AfduWjwGd5ZD0KPZjokplob$yUx1Jg3TTUOUPXmoTNRTD4wt2fGDv54Z1fEwWWw G"1e8de6mmmqanP3SPZUDb8kpWneF0AO0E6c9cbWGTIu52R5kkDHbsGkvOYk7Juug G"qAXv5$CR3uMDDh5SnOmIu5ZYgbKDvvY72uOJBSGt9bJLD$#Kb5aT#eVfcaRBtgS G"4nBDcv30uAWcmmVAkdAqzDqpbecGhorWzagy3HoSaAndoEHuutNWWKNcqAeMSdn G"WYCMJeWbd6xnsvLoo4ZJjo#zdflHpH3DTZ5JpuOE04bR5h#8TjEaSYuqOb$IXhA G"yPo70PmvOb5itbJZgyMjmb30MqO8xvtElVtaWWrDr0P6#QFr9Chhjm5yvwpoDkd G"b9otycoT82wgP7NX2nSPwk0RtJpMwIeRnlAJLAK#CR4SlanC90ISlm0ObrcqWoh G"yhCrGO$YRdAbKDOdJSdG2RdO1ceG0Rd6xuI0qT0aeO*Gba44KvCXuTqzdcx)0Fe G"(qb*d9etUGudceGeJqrf2CdAjQ528uGbsmbrfBVL3$LQeKGCOpLPUejgVcUMSLD G"UJvUPvmfVbPytRBdRCZlih7BzlBl7yPBAFRBbPzttYlI3VvUTnS0fKXy9VHki4n G"iZ5lNjmFjoVjiB6vg2nAAL7C2EB3Yu869Z7PkFrXZruTA$TB2Ft0N60Ns1Qo1Im G"9i4v6B5whSvGlrBzdlzb5E#Nb1R5rWAqkN6vQRSEJsZmnR5IQ1SnVPeevlw$hlA G"a76P72sN39D83mGL9eKNuMNaTtqo10EM0UDPmbPqC7Ufm3LPlHbwXqknlygl4Gh G"Z0aHzyswt3YIx6yKz9hOoL#lZBBftA1GKTPDo8NO$mOUy#IEJNV3HDhqV77o#Y6 G"rMwZcc8SQip9mpf3zSWPoVKmHy#0nVWTmkzk$PHI$0WnSNTmntNMLGLpzDDtASp G"d4IGzKp3b#Dy8MFoXr5zXt49qyB919kZwoYY6wYu2LtagW10b1$9m0IMR#Jc9is G"Wn4sf4wzFKABajUB#336nLzx3bQJnLyKnjzfRCKDfbljJtSddMVd7CIhNfIFuXo G"mT5EoM7YLofVFRzkYCYyE7Oa6e9eKhj$xaEFRXCMDLfIEKUUAUmK9YMMg7dYW6M G"56UaZyZM#CbHQNi4k0$ViViz4wM5MfApOCaJLbnNk$I9BYWmKw2ml76rYarldcF G"MnzUAywgXrAFFGLn9Enlde5MQPyx35gdLH0YY2#ghnDzOT24vr70P3QHZYaMYKf G"shhHEFgHul3Wyxq76LB8UH1AC3k7sYOC3SlGZYIOUNJAdTLrvRhlBcjG8BH7yzd G"YqyzQRxWvD8Ii1SXVQKnKxfVPtO9sEBw5#22G7jwgcew9yxZYGyDHJ2Dqi7EY#2 G"76gMRqgCJfeYcWmwiLf#yRRCLJvmcdXBgy1hgTqILbsLEOcckEQBjXE$3CP10zz G"i0m3T1bZSsQTSn#r675gw74MpDFJC1PrAi1mQSuPVgeVb$lRV0sfRhlCu62UFrp G"zvhRDSnkXvrhz04P0O55yIFFhNJ5phohNwnNJjmKFrQ20HrxznvnDSY5S7yqEKG G"#2SJ0Har1PvpC2w8qW6qq12WUVtqmZKDRqHSItQZtHl0ctMTuwMTaCUVBtU0kYi G"j9opsmA5UJQjieqBMb5IZKwNYChvJOnvVXAWpdNBgG0oFv##SZvhlUqbzyaJbYG G"c2leHJJFdYZ#gD1QAckhiGmQXqjf22fidPG$EitjE6nBDua$MmBTofrnOO4dKb2 G"YqlTsZAsRCDpkklEkqgOjKdKX4o0snP4oe0TO4o0qRI1LLFWHv1Sgy87ACheldU G"tvpyC7v6UOgCA7TDqd0X6Eunzc2opHZjG6tqzjJbAQtaz6uvQvTO946XLDre75K G"JN2SMTLSHaBiMGj91hMmb9FxhXWwNvT#liVV7C0UAGgek162mqdVzRtk6Q#f1B5 G"2gcAanZRiObAb00b9e6SaEIIGtlny3bjnaTMbNzIIA6eggzsHIgbKDGHkZzooqd G"g0V4DQmH4GppM4i1gklopH3DTZjjafQhg4bR5hObRpaWImRUfIBtqqWJ6StNYuH G"gKJmLgFR1ktycc1MqO8x9jVL3jay4OUi6uDF1VOEUJJeMrEkRhtClD#9otycar7 G"TTms3pdvCZU9BOnA4057XCjsS2SOnl1i95wXzxaA4o1ISleGJgeVoWohyhC740F G"51bTaYo0Hr2bq71b0Uqdi96G#fLiyp23KeXHUa6VnVucLidH8jZhHO2PxBzQurE G"ogrG6q2HdXXOXq5oiiUcYPqTQdUTBFZfiBCLgWNoxCtNwvMY0umLq1Ilm8WsgUs G"X12470qvZJqrr9S5dGKn6ShtfiAy4OO8acUoGWW0LhWryCWFDajQJKObEHwS3H1 G"HhobkoCSomcGOPJ1HjhSGI8SomBgrBEwhMzd75vCjNlAiQQXGb2XDmc9LDSyn2V G"YtbmGWD6kk8Raycza5A4hGgqT0aeO*GbayxrRaHPzXZDag)uQ*c*mfuwpvfvUGu G"dceGeJqrf2CdAjQ528uGbsmbrfBVL3$LQeKGKTHnVVTU01LOj5niJ5lV5lXjoq# G"n7BLlijBzPBytlBbjCd7zlZYVztRBtlDt7BDZ2Bv#YgQGGRhH1TU3nnOyfPfnOe G"5#ByPmkEGT32WI302262wq6MH3ITmoRFRzbjAlByjZ77ZoxqyS$M7pTzoJi49CP G"RCR7yPZ595c3Yog037z6fZ#yrByLd3ubpvHXK7i6uS7HLTYP6ppQVlRBPd76Ysw G"qa#IO60ww2s27MwYsx0q3Q0$6625M2Z6gVpPzGNChDVi2tQrHI5iKFp232MWUww G"DoIG$5GLB6SVP$kz9yCYok8Zf8EkOp9lsMj#Mo0hpzeFhMIHuWJNCB25eMQ0NVf G"e3LUoRRbjrfAqNArb5p$5psM33DSLH2CoStlldorDtx2w2DKwqACnDQZbrdhAFy G"cYw4hPgZGN9JGW3c5LDPBqqRlI30Pn3SH8y0BYYIhW8Dli#B4Hlz3I5dUdgeVdB G"DzlDeVRbulnabk*e(LpzfxKB0QW4G*0c)q*WqpXumUymU4nIrn6ObkibGyHmeeJ G"HnG4fJjIbHjr0iqjmr8iYiIpHmrulPjIxPJKqfbeHjaHJ5nSjgdSG6OHT8Lb0HU G"0fObeSjm55n1Ho6eHevb1eMLbpLzM00LWKGQrLnKHSjnUznUiPLjItHk6ig2yg4 G"Gg40MqLfhfToLfSPQIzmLrTVeHaulnabk*y(rWzfxyigvEvhk)Whb(G*WqpXumU G"8Kqk9(smajvyZj4KJA7XuNU9rcgeWe0uU9wEFaJqaAWX#w2gtxow5I4d8S30PcY G"H6weNaK$ZmLPjvOdnOPeXfy57SmzlorSbo#qhWHA1BAzPG8gKOhvQpTQqnHd9Pm G"nMFLQffRuLajprlAb$krdkvdkbiwlWZ70Pu9FvOtDQdyy$GKKKunRqTOt5#lQqq G"2tGZp1S2uHWFqZu2LiM27rkYh4ajyansYATbybnyaXsYQcb4bpyabqYcDpctyap G"qYoilmazyddOOswpVbv4cdOp1KqEb#$b#Fc#FbAvo3aZFGbuGcmaj9anGfnGaNX G"MeGk8RFnmB5PBDNBzjtv$xllEtlDK6$QzVRCo#YGSdNJ3T01SaSJWgdC7OTSHLS G"c#WHHO2GFLoEpBlRGBCyvAaJmJgk$RZLUYDSWnVa8RWEHaGkpzfRCfCKdlsdy7z G"Cd8AUrhlAxd4VwacxyBHI2NByzBBfmRdReda6Hfl5HDyuYVugNbS92gM1oLMsRd G"5g7n7BHZX#1H0C5bOBsak4BdsetaJx0bm6G2dYhYxWiqg0jiKgG3waYbCcsG11w G"ZjYWehHwLHixGunGoeuMN4Evxm7XfBTMgxVQvZlN8FMFqRMWwc6tu0Rra2qcY$$ G"BqbEW3wN28PXVNHe0#$hyc1ITUM1SLvUhKG6$$b6$t70b9nkoMApIg$B4hWrtpi G"X#eBu#NyR6$fcD6oW0BbSDgGnobvBasMuGLLtzpZzPvfiZfPvjiX$yNzEcTQdjU G"b70135zcQAVhWtXAkh5a0QfKNGEfJ9afGoIX1nPXi2LPjpUbWY6$TR$eE#f1Rwc G"Aa$2UAsg#sotHREqA1bs8oK$eVbd7hyyxGCEdvTuVwLQM2G7e0FQQ$mvTlGQMMk G"f7bOiRJympAfqsgfzJwjJTz2WDp4fW97J7biFCJQVJJ4ThXk#i#0LM$Fr$G9R#r G"kFutDeN4Ezm22f1D6C6p$$NiNBsADFTkcjoEgEMNMOSBM6AKpMHN5r1QhK4o54j G"UsCtxeJ9FmSRtoZ8yeU7IW9veUNHWDlyTlHWVbg7hyytiTUescQNdWPiKOryobL G"rfU9bqjpbuY0eHi$wiYEaiYOYM0Hamif7py3QIDiumpcfZLqX8jumNcfZRqXClu G"m$cfZXqXMBOf3$$$IsOrIBag5#W4Le6g4fcDd4y8PCgtJEVU3KJUUOJTHDPnSZS G"HDJnSdSHDDnStRHDxnSJQHDrnSZPHDlnShj14iYl6fs5rUGC2$JUZ2jP95OSpMH G"9UmSFLH9OmSVKH9ImS$JH9CmSpJH9wmSFIH9qmSZHK#jK0oeu2zyNidMXrgEEKb G"zj4amkKbAfEtqReYW0Jm4gGmqhM40JHmaEd8MOkwFqX#GnXBA$HNrlb8mSuLZQa G"pNtLBnpW6ukB4uQgoLAfOuivGsrzCk1VMYtRu1w6iUWyAoLft$UIBtaUraOymhb G"WuDhcRkJd(ZdjaJlafjaVlaST#q6Db8ha5ANAaIsa#AaMsa#BacJuLbymby9b4m G"#SoaNAZWaUJ8dr3nzadkazzafYHEz8hG4mGefG#OwmD3ie0uFapkaHAaOfUvdys G"bixdqyVyditbyAd4tb4Fd4ubyK0ema3CaZsdpxRa80bO05whqUcWzhWUcWChqVC G"2hWVcWIhqWcWLhaf3JEafZCFaQfU3dyBbaDA4CKoaD1ouGYjVwGZrtFbwxassbw G"vqlkQ86uaprylZteOhGNixapraTIg21u0a9bu08eu0aA7hzL1JpH3E9JJrozMN5 G"xck4oQZ9c5gCbbf85mS3MH9ZmSlg3WzPB3kk7sXnCtm2rkNU8bqFiIUkcqB$jIU G"0l0MGMES5XMuYratMEimf0e4AwhV2wfaPlBwzc4KDc4KH3aozyQgROHekod1C2N G"0CgC#naYfWVbCa61VM8L3yoD6nZlhDAMBDR2qMdm#K3lLuX62WJQHDrnS3PH9mb G"ehsEpXnKYEGuE8Se93if2m07xHEpi07#iB$fd7PyyFed7EyyxdPFeO3pGYMB8#d G"Qt6UbEys8snsb#aEyItcGGtTaQZWtef8c2JfHEfP8DKnTH7Zz9izTa3dhVfiFbO G"xfyFbizf4FbOAfamRbSajmavSayOSMfOHbiPfaS5QwGjgGWwGrgGgxanXa8NYau G"8cSYae$c0sAPf4Le7hyMsP9aGZdYb2zaw0bGz8vhiOmDEGHs14bayDFh4OkspWs G"dWepqtjB8aBLu5FYu1l4peomA2T0mSaMj9WcKaDu0gWmVXcSaFu4lOzEKf4aGOy G"MtZkZZNQGnft9(O4CLtXAZmfNxiZWsRqMpIEUEfM4A30UGsh0rAtwdGsAanmBrW G"5fSf4OwGdMGcuqBuoTVzJMNgyv$Vd6K2dInxXkGewdWK6$vqzKhoeKhag7JHN0e G"uq7uwSHPJ4g4y3SSnSNvbhlIu9fu1mE2R35oOhclOZgXXa#$ggWVtj9Zli4Chrc G"FIA8#aXWAo2AA#88$C5k#yTV7YDdA22sx7wMmx3argJhXpSciOHQI25TWqzY#b$ G"OHEin0JGH2kSyeTI3cdubW5OkWPPWmEWoA$1qu7huULDS0npNiJ1XHZMZLnGck3 G"II7PatBZ$khuUXdUuW2gtBeMMshU14fniTejpxC1nJPfGX0eWyAdymncmMwbgtZ G"aJPDW9aWoa3tz8nWyAh2xq7LjJBea0liJmTKfWSjLWaAAgUGegWYC0tsPNscFLe G"Elj8xs4XKWNjHlx5bVjHNtcFNeEpj8Fs4bLWhkHxuc$O4R8yKFcwdo382wXqMsR G"gbs7FzA1Hcob36cj0ozl7dSUL5InTKfc0xi0hMxi9ygHKXLPeupCi$m1VCK9VSt G"O6wwk6NlfMcfa1JLTvW4Mcp21AHRPcA$cjt90VwmKCABZWuP6AiOZXRMooi1YYr G"bRaBiUS2bVNTVrUhez12XQUUTTSKWOhTP9SOfLcEaw$DzrXH0omkoI2PXwfkK6x G"qb3XrClkppk8MmeGFyZlq86o#2#MRhTbPOl5ZtKZYvisVz8YP2krsMH2sYxa2oY G"2IMISLK3aLlNDitP2gYuTTH8kG9EBS4PAwncrvYQCD7zJHYiLHYUD6xNBA1JYS$ G"nLzcTTMymZIeK$tgJdiCzzdtWq#egMbW$TF1TL9UZ1iSMaXk0z7qcG3d2vj#$kx G"tkl#AAmDPbGLa2NlnHyT4TQ1$uWAbvRp6cggBlr1FcOLQnxP$d8oG1qqLVcJTEz G"1$Zk3IQKNP1GHWGsypwA9OqRHUGJPk7LjRXfqwtpGSMtGHmul6xxa5zBx0FqxqB G"xgosUmKJDmCSiRR4gajJJTKrJEauojmoMeczJzxLSRrqNBaGt1Vdg2PdxC66I9Y G"cPCyDliD7BPlikdkiQwbrpxPLrN#pxqiS5QXKo3WGWTKY3nAdekCBmh3tYK6uIw G"LrilylzQIPhjiOhBnzRo7w6G0I#S4ws9#mHdI09UVjCOlVIYlNUa1sdqGc,qVtw G"XfgV49Idd*m*i*m0tmfJlevKrofutfbYqpXumnOWvj5erpD1qp1eubrvdkqurtn G"Kujbfvj9KtGCYqpXumN0GcA0GcqT0aeO*GbaqbNvCHfeOoF#h)C6b)c*d9etX4s G"tbbvdceGeJqrf2CdAjQ528uGbsmbrfBVL3FQ0nSJDTGmOSLTVDSHLUP9TUfK9eK G"X0MZeN0eKInV0TSZTHki4nih7BzBmqUT#lx6csqe8Z0Y62Zsx0OC3PHTTLb5wWr G"COSnSZX$hKWeMWmM6G4hgj$ZCO4ejCx$uMgZVs1IIvQmF4FkrlI8Py$sEhtCctA G"iFL7HK8HnMcLiLlcEld5RlAtRktdkvFQu0pCYhEziFhgyT8Rf5CqSOoLi1Nugof G"R#uOJMifVds9jnAqIUY#WlZGwuK8DAHo1PWoySUO#6zWoAAuvsNSUMjVjil0IEK G"1ru$KMYioHrRHl4m5JmnHzqQkZRLdr#a5yIdKmwSMuJkKTgsYh4eFijFGDrKpaR G"RgcYh4eFiiFGZvdb5d8Hcwdysd5ZWAG8qkhcynqs#ioeSgijF4WAaMdbRbOn6cK G"KpmLdG2Olqr#6GqjZD6ucvapRV5tktBmFZYqIuIkLSgInDQhj#4lsYFmOKzAFXh G"yxZzyiHmudkrIpqRqshJhzH8bN4JinCZyoKHaLsyiJl#WJ1N85cEXhe45cEXhe0 G"5cEXhzAKia5X#fwoDBBtb7fFGlnIp1wOd6qxY4GI1nA2#tLBApBAGwEu5#26chJ G"rX4MhvQpTQqH8ju0EFw5CWQbrfRMUYnVGeUV59LjRQHzHWMtuCyWSbulnabk*y( G"uWzfxS63LTMzy)nvc(G*WqpXumUuewf9(smajvyZj4KJA7XuNU9rcgeWe0uU9wE G"$MQ1MgWjCStGH9$$VH3wxtcK9bOdOHDh#rD7qas7e28qI7aYeINQOnTZfKWvUV9 G"SYnSTfKJnSU1TVLUGuU11TGmncprF6ubzBFlzlRlBydvijgAKoTOfuHSfGceGVu G"W8uScuGdqV5yFGbWyB5cUJhbjLJLGDWcqXcq3fppbd7b4FujV03iaBWW2YkdDTa G"HiaNzbdydbAbj4qFktJr60iqV9HguMY0PuMTQjcgWtEvxm7XTcbOMrOb49$Qw1J G"OvOay4lIZd9euMEWehHj2O8pXw1$le60DGP3cy7ob7j8c3b2obvBa1Sqlycs2fO G"JnihjOjnUbbRaLPjpUbc8JW1TR$eE#b#QLGgenvVMzFcXG5odmFpyUswbsLI9Yy G"Em9LfaFVz#EqUrnL2s9OvkAvoarlzUx119GOaUFaDpU0Uh8K7EsXCVECJQpLkI3 G"EeR4tlF6uC$Fr$G9R#rkFuY3qasCVApN3Er9heGP$8$tSheITK#eHRVtCTf7fx7 G"6naCTLnXN9bPy$Haeef7qOyEekMlHI5tOyofkMxHI5wOy#fkMJHITR0AqZ0sl0i G"rSBT7SCgj2odK7hLDTKbaDt$o6gAHq3a#efevKweITIuagg$#sfN9KW3AnfaFZY G"MBL1Ry$kf7d2e6M7VIgTewFKu06fdqrd#tv047POHoafnxafnqTYcOObFRkA8Gv G"0qpGIMNGIgOoDbye5Zc31q93U2RFpb9ttI#vTkWHCnPv34ghqUJDnx0BzQA75Qa G"kZAxfWZL17vbK1inqwVwqC1y8UZGQXkA0aPOvO4mb5lfYf$#Q53iv7a8BGUM8BG G"Ab8BGkS8BG9x#nKpPpRE9RjFzx6GL$JcW6e7r8dWKMOe3d4Ufyaz8hhm59FIplb G"X1tpumEfEFOvSBaHtuFtYFac1ftClcvn1lqXQHb$O1zaXnpdOhEMgDobhQgCDo1 G"y$a31Aw3emLe8$2mom128nd7TzyFnd7Pzrl03ft1oe90hG460CBK7U$2DUao7do G"ad$sG7m6w#$BHPFx3MpdwtZQo3$$VMeW9eG1nGhXyLUY03wmGlo6lE5Z30lw50f G"HZe4Y31098RVd36FWfF$p#7GgWytqwZYGkNqbdEjDSWYFHR617El#XH1vrLhGsD G"XuhWNs8Vfq2NsqElkL5IVqGJ16cXydKH801G8uG11GXgHi8rI$sZR11IwpuqFUd G"vD7uc6qPAXP8MPX6IDOdj44t5ITHvDXonNGmw7ZC728$EKHeCUfySpDrQBdQNcu G"77YkBvltVVXib$LWJ#kdaKjzmaxwGOpZKVEnySNRc9xVeo2T6vZ1C81JGKPdyaJ G"QctEDLOVPzb$LWJEUGptwA0XWDFZbK5kbz8GOgNLg8OeWVMUreRkK8qTUlWvjkL G"RBb#vstyhH80BAVUnGKvmXve0XfO$Qx76Y8l#busMxPdFN3FUoCWVNGlUGlSOcK G"UY$$Din9W#eiH#wsOjt3N8X$PtG$EGtoQahDTSFXLtOhx8F6HQ$ZQw0sVsSlhpb G"7rbhGY4lE8snQlt4dTFdiqcQUtNEyu7TlwERot7Nlq#ltYZFwltWl#9dy6xv6#a G"I#o$pQso#WkGJDVU8hBqdhGHhXbmu6U7ypqfFXW3jgHbmFC7R79TzIT5CdOnzSh G"U93Y2JOQydANWbCMs$x2pRfQcbED1pR5jiP7#5zcP79yE6o2J6eNv25SJoNDQYt G"rsxsYtUCWDHUE0XgpiANYRpPDcoWOV#RV4Gh90pXOJ6awxNV#aqFS7NiBxyStdp G"2b$3yhT1x$NA8pX#G35bE9Jg9Zf8l#4du4aLK#h9qpGZ1G4IM2P3N9FuC2NylqA G"$IAOo#DSWnzI$Pjz8reIpmUy0LLLvwRQ5sx$a6sRk8c26KoIGmhCx7C7AxlbLFc G"QsvvqgAdcBUoVOVAfNv1XL3dBrW8jJiZvb3#VENIidZ70D7Dsp9UgTGYCf8byf6 G"hZUR4QYPgsi0fdDWShHE41uzubJzSx9x51h63SDZ$Vj1zbm6in3OUQVIoNC2n6I G"9F0nxWJERdq5EHwgJprRno6AuxUmC0VXpBR6fDJ5GsPY403s#V4NTKAO$lzg#ht G"64R5IwK3O#3K7aNxlXDyuoT$xhFUCDE#NIY5SC94NUl0XEvFiPosukp$yt0IFzv G"Rpmr0k$bCxfaGwCCJlWh7og4l2Qg0xeQ36DkC6crGAz6YWl5wPwwz1G2RF9wAQZ G"Dx5c4D9k2YPXE0x8$vA5FuYlwFLtE$ONebnRWYNQhODsrMCRFHEQ6vd8ymbpSdv G"$aJI2dzm#4cUfqNwow1xiYiCo$hSRdB1ylKJZm4pglydnycpidridtidv4bxGXB G"XgAXh8G7ggrjkrbWX#G2WHkqP2WP2WR2WSUq22aomdxok3eSNhWkmWkuWjKWnK0 G"l05c86l4a7i0IJUh2j3gGM#$Z0ywrNIBkJLTVBcMWCTJjeDFJUuNhKUwCOdv83N G"NtuUeKNK0UkCO8Kxi7k3UbCOUuXhnGyEuc9dBWNuZaMIkpbgezmYVsGN51NrirX G"3c4BuIBhp#UceocYUb1S#zO5tqzlV6sm6HY2qZ5ekFeSnXtpbKJVyJ8lyZYWfJ8 G"f8kEyejqbrEdUiO#fk96#XE0wtxnWi8bIC5srOoLpXro6vZG#ixRBfRRm4dwBDY G"ZZbV$aE3c0ehWR7W6LF$ShfXnr#g48VeoFNpxUyCGzFUmKXbpWblP3XbtN$RNeO G"Tw3rVE(38jUyNY$vImdJmE$VrLzl47rwjy2tnde9zGfzI0#FZhnLnElcjNU52NO G"kKbckBVjethkLOKB9XLdTKlRAhbvtBZftezj9L7m42r#d2tDu4K2GtriVa$pnm9 G"gYqGJDj#Nf#YrEkk$bI9asaI6fSiCHN#bDwvulxOu0iNW9UhTs8lQows8wuFDbt G"MspDEv12h8vkmRMO1Dft0fOk7CEbHmSYDTWMuAW1r7CDDrx$6j13BsfFGKMrU3M G"usUbi3gxP4qtcFzuT5igF5PxV$hWmvHGOoV$KtvNTtFcrkJBmzZYr$xIyyCXXFJ G"gdBrO8hOUMRzl$WsNGvg2$RVN5xPxOb2grV#oT1LdPft2G$iiSwHOwW0LSO6w4G G"94eHcctvUfJrneP7uxmtAzmdy1NHcKKVhrINS#b#DDXd8XmJ9YzfZfWZi9srnbR G"lgusEDfAG93xhOwfpPwEtA$dPZEGKAgghZY8g5W9RoLR8Fwb8zlLJAemB7iRRVm G"1MBv0tgl41Tefv6SWOn3PIQZkxOjMIlUQcuPjMkHCVKrnkfPwYz1b0UxaAnReNp G"7vY6Bsexb8W11wyrJItZmY4EBzw6XNlBJ0ChkR7UebRBwxU3R$zTCKyngzEcq4z G"j66QxywxS3d86qY#WqYX7eAoNYraHKC6Tdu2jGY2zvpZB0Jzdv1ED5ovAPmrnqv G"I7L6iocOHPD7vGDWXCpVZg7r6DrildlDzklJiDsn103CaUs7BS3WbqG5#7Odg#v G"q6kG$H5VLmM5qz6wL650b5Pr9#kPlhz5nyCkDJRF9uhY#k3j8nJ6IL8jiH#0hY3 G"3yu11v8dIu7bBE$HT5BDSIEa44n0dSZ8a51xQL5eBz76ZmUSJTPRwr3GKHvK3mG G"W2Q9TEV7JoSJg54gursC3VqixyDwEb5ZILJp908hXfjYFVIphyS66exKZCe0Q4Y G"#cqCV5lI7PFE$cEVJ0Ej1dAcUB4oavFEc3nDhqRphlvEiQn5iXXth6Ioi#vfGUb G"pe9jBikirxafrH4k7io0OlqJxWiWZWYuEkybYq3WTULNGFWefC7$6rgGF8bFy3n G"PbkB4laMZTaWHD6shcbd9diUcymVE6kH7hXfijlW9eva7TsueC0e3HfWD4v#pE7 G"r4cU9UUiOoNT1WXV$lCT5BBR1KCa4e8FA$GvzFd#8O86y7qZ3czUVII2edPe3VH G"ekpo0kMPluLTpQAw6wSSpi11ZX2rxnzR$6m2LAPvSz46v#y$jcxkk6diax2rH7R G"VoL6ef5fmH69T7FWgNH50MSDGY1cdrFW0nEs51SSDyvDWu2#Y$9JU#WLLnQyF6F G"SAz1FrnxyeXHS7Fy#F4dH4qH4BH4DHiOHO0HqHano#OD0Ap5ufPi9DeB09tmvPn G"jRteXP8#7JUBaKUqs3NFDh$PVwk#J3bYsqYtSKj8RtYheloSbyShGl6fq8FD$hC G"PJU8DmDZ8OpEx#$tB4hQivbPB4O3gishlRwHNWBpH3D318hKaejip9x$MA92$8S G"fN8gqEsj#oMNRizgG9ecHY19aj7cm959$8CekZbC6D7$m2ry6p7$v0RWbC#vzDF G"ahMhqw88EX7JT#5pi8HPmB3xT93Tcb49h$adMA7PFN$tTJe#wO9mMhNHOhfZRuq G"r1Ghn9Ghn9txaNGkLngfhIRxK80ijZKvhJ80jjR9B6DipzsYm4EcuS5uJD$fVs2 G"6SAnLdiptJXEJm#6ySvB1xkJ9ez84Xy7d788ng7IY4htlN55CYi6ULUrLNWLUGL G"NfbWBEEeiRt$UkRRfAAflWg77h7FlEqv$e7KN#4hajEDQMo2LiJb2IaRgIp4VJw G"H$o8ASxgVWS3P07a5YGhwBuWpnRRm$h#5PFyTVyfWxWxT98IDA3jEFv$593YomK G"5n6LrL15OieG1gT$ySUWas7$FWCncqL9srMxU9x2$#Q1D0dBbeTX8s2$yz6Ewb1 G"O5gEY#xN5cHy75EhL7QKCNhi3R4uln9njcYG8Bm5aXi5mee5#dVtVIJ$3juLlpA G"FeF9kSNNzcoo9dG7mr1DNWtFRAblsoeQvTNYjiDMJ7HwYpyJ6amMbAThz$as2ie G"AABY#5IiMwRBcC3YaRu26G9$zuH67LTrnj8OwUQSGWgCVGh5j4bWJOFLhNQsnLi G"Fna0kbiV#46RHrwOdvSFITMhbQA4LyLZlFyk7OkaF5rSvNN52NVXnBZxfWZocwI G"S$07ljhN1ThanBvMpajYvWzPPm$b0Q33fy3YGZdwAeURn3s77bAZmpp3S8$EiwV G"qT5Nv4r4KdNxxALHZ6t21csJEGgG9Snd9oC8gGVCy0z#t0a8ccZGUUWMogBBgSS G"TYBH#2s7GWAdA6van9dG26$eaTdcOz222gJxrY3NSAGvZ#O0T5i2H4ix2GeDxUD G"c6hyVxEVEdF0hjkikBdM9nOyNaFZHj63maZ6xpWN62rBgti6Pn0UBqa0V#o0KT6 G"xFhomK5lgAdVKAwm3IzpcrF6yjTWQP$Wrp2WvgFCo#aIq9W#CE4yIVtJGBY$$uc G"IxiAYfHbBXXnPJOyVQGeABFuLsdZoP6f$Eg0CTMftQEDrNgSp#neJQcOgF0Qzc$ G"Sg9aZe14leBW2$v6iNC8b#dF8zyBAflC0tQTbB$V6Kme8Fv4c3MJrh4Sp71OKOc G"F$4pjHxYhE6eeM8mN2jevQ#R6flCNUEST49Zpk$hMmbyiezqkU$8iBzsjiIBcbr G"TUXZxKBmLRJJsueGWNnX3Go#U$CzWiSXij2LCnngc7nWai$JbqEH6A1QCqD3qOU G"EPxy7lM5tbcnggIJsi8mzqUqOPdpGpLoV7FKEGfl9DOI9Jp1MTdPMbbaWG2Vnqy G"ysfqUYEPqSJVtdxkAO3j8kh4aOGYt1p89hhWkhch3G$QG4m8wemxb7B0cFREAOu G"udfjyPC7eugb4ySWCHFa8JxYbOa$hRBefyCl2t3KywS9ch#6kXQl71DeS9$1Zp9 G"mQX193jujL9gGoTUXaw2xp5c8kX9g7v6pfI7pg27Cce0cnHGkZf8kQbKrhXnG$d G"AFdUn2UMWXgWi2PYlsB6ZJDEFasNPpqtFHbGiB3ak7iC97PwPr#tFfMC6wVe9vW G"D7Rvk0g2lXgikATRpT#7tbUIZWEoiQYtplNhF7h5izI2dff2IFtbKPUG5CSdHRs G"a7x7RHlTLcFE#j86tBCJlL0ScfPMEKwyAUS#nNEMmhP1ffGrmL2EsC0wHVRPgFE G"DW9aozHQMfHsMdsfuKR4OJLAp2r8JSdrh0qJdw9H#id2CEuzMlCRgACgy4HJadp G"6ZkpnC0sGaXjBlFqdAuu7Phk4UDokdBju9#G4U#WbDfwCRIWzC4qYpngbc2lw#j G"2S4t13h$pHTc2e4s1dbG4AMVyeHpSNOgG2LPFaGUVyURRz$7jkf4CEdzi9kf$IP G"g9bQx8wmGRam935#84TQfNN6OiX$pdqy5SnwJEocqvT0$VtBx8Od0pi6nqpP2tp G"Mmbp2umgJx3PcN7rd4b8pZh9JpKrHiBrGiRfD1rGSJrN8iuDpYvB$oZUCoaSnym G"3#HzuPtnjSAD5HzWXypYHl8UvWga4zR1DD1216UU6yC#xVjmBZKeTdsox8MSZ$G G"m0huDiM4MCUV3apWkjMMBUOIXaADrn9VmEkzBgAR5uGy37HUK9uiv9fEQev$dYT G"Fb5gwMj36XKBF9cBHH9w#TQBk5ETBc5wY02uXnF9JcWWdTGd4oj#Cp4kjgSWS6x G"g1E#vFQXOnVWjcMP8gOaShFbOFM0JAVOPZ8X7o5MY5h93nTEm0E7MU9I8Fd5mUy G"BA#bwCpc#bGskaUFTj1N7kqXCX$kd3P1R77X6h9iXTb2DlxTFGp3hW1VJaGoBtF G"G$pd1Wq6Fr8RttQLdORMFvS$Gg8xGp6bNRxcH7la$)l#bMiP2M5$hKQZeoCIHyv G"IpW9N4$sWN#0wi7DJVlfpEb80Z5van5jiJydBmToEXB8Fni$x9Qp6rozyg$Q#eD G"tidbDcnjJ7QanzI746PWHWjguOMNl9cpXCbe4pQet0kHpa3wfHtCxS27I3D8eC4 G"bfWH3$tPiKeCV4VGOhf5h5Ih#wrffK2pKFhWWFfH70BJW9sS2ziKBmvc8E6Zn8d G"e#YDKTAechEvOgjjq9ChXZwiqdTOfW0cVac61iiwP93QMd8TU4JCl9rrWP$zCRj G"ckMk3hy#a5wFDbQygYDKhbczHN$r9Q2lgANUMf936#QeNaeTpaoqojSwT3jc02N G"UpDGoFUjOlVUH$$h$mxVqXTGrGiVnzOv$a7jaQm3ccwdiU4Y1Grx91bYDroitMl G"3ogTeRfossQmi8Cey73x6Ju4sHbIbOwNBd4E4fZFC1tTE7uQw5n0x5vCHLfu#Dv G"qk4trHoq5FCcKfnM$RzDyDNtzcS$Hk5VDNa5VClyoVQ$Nlgfku9GKk#de7cNtG8 G"l7W7dy#h#vWt#o4Vl7CtER7bshMWqYrdsuPxV8WdPK#ls9rFWc$Kaw8WhQlM4sb G"titPzd2EDPWbSbhmpG6PJQh9p0Fq0dQPsC0fFTc4s3E7qdSZySnNJ#8KmfTVF0j G"2dWzGOXKlqsN0ON#5x6jM85t6fpVgJ$iJf2bx6RbUXo6KeYB9fYJsWEh6Hm1hps G"GAlOfIqONx6vk8nU9roS4Wl2AlJeOrkmewJh5XJHGq6c7VVGBvHogBcynhig4fe G"2BOPE9#I0meGCemB8h8AtjpajCaLGJYaCYymalBhp03OaoMNtnoGJ9bgWBfbXaS G"ah7h1chFIo21X5UII#aU7nC8i6zhah7I4yV2A44nXXUgyHDagJJD$9URJJ9xxHJ G"Fhh7I5zNih7g6z3ih7w6zFjh7i7zVjh767Eplh7k4yNlwLmmG$VGbCq20PcsPwx G"32sQM22wwqY00kw5gw5Mxq2sqo03c38k30Ew0sxqIYXMsqgZCMtyCc2nnTJvUVD G"UV1mtx3lx4Sq97kgEbxgbO2LJ9TSfGdnSUfKU9nzN9xgKRAfKMnTSTSaKQOnTZf G"ec70nT0P5Ko7hKWnSNb5FRB0gisx0k3YW9KmPoLOvfGbjylzQIPhjiOhtUVnU1U G"LoiTOplU1062Zeois37#MWHQotM0cuSwGMeO$6q$Qrtktl6xE7n6taLBWUsnjyG G"rJ8boWbQAqRqfemi5pWC1f8a9anJRvas5auSsscgGXHxamdVafWSlGV4aOPiJMa G"UQHRaoCrAaHfGKLW#bC8guGqKGfTOfTGfiyVMWycvGRGeKWeQy9aZegMWeMxfQh G"4z5EocblycwyAhU4fpbpcc3bq3JqeySjCeRO0T1LTSnLgyVbZVahKc0apcA4Dhc G"KBq5nSBVHD9nS7$bSeyYUWeSlZhS5OCKGEKGGKGIKG8KNobu7J6tFC9s1gqL3qf G"OP1H5HDSRj3C7ww5Aw2#27eDHTTToJTLqZonJqVwZjBATBAjJMXIrrn5TUYaxXb G"4YOMyz8BRtMAhDV6pMEdkz1pBDyn05SUNG155yDGa0L1vOSBCxA35pai20Ilhaz G"NoaYIE32nECUgrRYGOLXYddUU2s4#gUYq6RJFQWNoBnlBBSMmaTha35XyUzdrhe G"QZkYEyN7CeKsTXOs#aWAxGeaKfTJdailA3oaqwka1sdqGc*gaGMCwXf8XkPxjrb G"(GQr)g*m0tmfJld1GabiXiuuHn3GwIAUnpfyGetquX2B59hzAD7yzBDjBzbjpNl G"DjBAFRlrRpBOcMo5yPBEHBzMo8WvUVDSLDUZP6W1$wolVpd1ruKSnS59T1LouVf G"b1Xo23YMOBbpQ$RZ4Aqi9J2YgwYccIN7O6yPBAPlBKFvC76itwXkxqm8nDKNByz G"BBbbXJQJKW72y8n9i49lvjibPtFkvlQomEpeP3WnnA7M9niRzAyL7zsE323W1nB G"b5ldkt4EdYqgYqq8wLVyS1Tnm6DJYuC8EpcV0#bPrtktlY2lR6MnnuTn9CSOry1 G"0BXwxZA2YkhPlMF5Von1ZAUBwuIc5l7H8kPubTwK0zivz5cSVizPiVRyfzktji7 G"zpbjmm3tW5EcHdtATViFp0W6wq623KSs#jiIFccHfTVW2tyzXJvUrzmuU3NYP#Q G"p3Yi#cUdK30TUYDmdF95jeoipPmpjiwwtgMTLvLD3s2e#A6LAUQ7UTZ5SS#h8P0 G"LMTT01odvT0f8ZDCDCtRXJA3H56hgvxA27i2fu3O0eDpz5CtRElJ1Au0eqmLSmM G"SyUKPajtj2IOGpxDCLxuhnxH9ETPfolxn#DSIXPDZwtvD3LYTmpowxNuPRzzxd3 G"WEgRNOSUUrP7ZOvnzIIEkwB2v$Xc38Ic1RkUnNAQI20eVs47DkdFmmBEvxsjwyI G"VASGM1nYcAVnauz82amPlAixf3aGrfLLzZV1xjrk$eU8iEYOgBYgw6ggVdh3fRR G"LZM7WwPSommvDEO41wDFuMgc3KfRwkHm0uFNstCPhPvfP2G4VHw2Fk0#x5kmTcx G"tbZRNL4fMWq0LQ8lpHLONG3flCa71zD60KY5M32kgQvgwho5RfdLtN2XK8MT5HT G"PsDcWRM8R6uArX4IURYInjtQtjAveIl#rz04mRtJXKg4vpVBBDE#fBzqhPEARbT G"mHjmbPtgeTthM4Sj8l2WoNLnJT#xO55OTIx2$ZfndPMo8hUZXYBCMLWip33Kjqt G"1fI6ch7zTz5xCZ8G4MlRhfZ4FTf76u7Bqk1Nofk1726auLqWM2#sr3WohPgUzv1 G"YQyNq#XsxB86XuErteVyKuB3UgAVXhIBFnwZ3xaoDBACA6OxgxxNnss5x2VoMtH G"dTtqezYYoTytlzWo0YtfuQasDmUoylJRdnkX#mk5kPlXbPSNYrO21HrtyDXPOo0 G"yC$Acg4n2q46XFxVhkeBA5YG3UE3YymytjQZa$a1HcOvulcg2bnDV7BwSbXb5Wg G"fXc5WgvHc5WMcix7u61yyJ#pdBasSjk#UKIDycOD0G4maFBNf2QqHnEPZJaqYKd G"mfCafrotZrXr2gpnkb5ztRDQZBMLH9klvQykVGmf$hhpUqNh2WOZdCowxMvBkOV G"D396xvpULZPKOLWQVJHfHPHGB2PbM5Hpmp0KWG3WyUhJ$teEtAd8ulp#o83DTZ5 G"GLltykJeweKrw4JYiuQE0QcEgz0uOZIPKHCmuYKYqjd#YqjtpdLmQNNHsgyNJkp G"jmwYOvi0eHDdeknMUaKspLnKB0uhMcyozkiMH1mAIjD44sPBItkRMWRAY9ibXlA G"gXeeeS2feqfOGErmgjc$eJyhYUc765y8QOeB8H0i3zJoKJCkG1jOSnpidjE1qnT G"#TjBvMArX2457VjEd7LvADzfdKrxIXTO2Gmb1gqb8MxutJVBlpRH3rIlcca$2Iq G"H6ZhbKKVyplilemecoTjGHjTOnHA3A0MOTrBcvibNfcWbqT0aeO*q(WrwECb24# G"#Fid)yp)Gc*svuqe1urUq0tdrf0KM5acYmW1aIX8g3qNWKg3qq6GMYaItmKtaIj G"ggYug5acZKg2ugcAM34rjsXPKMZ4MWWgqidxidqeg3qgAkM3yhkQq2iYXqN0SWg G"OaqkYpAY2eg64cqaIKqhAYM58MeUWg#qcggqmNW0g4Cu4iN3Cg54vqiXLMq5uML G"osAAvFwgGku38XqwgIEN0irUMN2KZPYcR2M2uggQvBcc4eMZqXGshrohxquIsLQ G"Y2nwWLUvZm22G2jExro45ugkoK3WgxqK3mgkR(qTuacS(k*y(e7yfxejXa4wah) G"Gqb(C/ab(i/m0tm5crpneulfGalaGc*gaGJtwXft1cLniCb(q$r)f/q)c)Gjh)d G"9etUGeulfGalaGc*gaGDfTceMMfp3by)qPc)i/q)c)Wcn)mfuwpvfvUGeulfGal G"aGc*baq5twXf5gTkmoi*T*e/q)c)qSo)d9etXa1sbiWcaO*GbaebNvCHHyu5vDO G"*Fe)c/)G*y1d(WqpXumU8Kqkb1sbiWcaO-07KvCHXlEV4W+d*c/e(G*Kzg(WqpX G"umUqurgb1sbiWcaO*GbaqbNvCHfeOoF#h)C6b)c/e(G*8Eg(WqpXumU0uqqb1sb G"iWcaO*GbaqbNvCXQFx2AMHb(0uj)c/)G*mbh(WqpXumUuewfb1sbiWcaO*GbaOj G"NvCbFSs6vsu)OAe(Gb/e(G*8jn(WqpXumUmeulfGalaGc*b(hz5XfyJ77$Hm)G9 G"*k/q)c)q15)svuqe1urUq0tdb1sfy,kaGcaqH)qX6+a" N=15599:K=255:IF LEN(C$)<>20799 THEN ?"Bad script!":END FOR A=1 TO N:LOCATE 1:?STRING$(50/N*A,177):IF L=0 THEN GOSUB G:L=6 W=T\P(6-L):GOSUB G:W=W OR T*P(L):L=L-2:B$=CHR$(W AND K):PUT 1,,B$:NEXT ?:IF C=108 THEN ?"Ok":END ELSE ?"Bad checksum!":END G:I=I+1:T=INSTR(T$,MID$(C$,I,1))-1:C=(C+T)*2:C=C\256+(C AND 255):RETURN SUB G(A$):SHARED C$:FOR Q=2 TO 9:DO:S=INSTR(A$,CHR$(Q+38)) IF S THEN A$=LEFT$(A$,S-1)+STRING$(Q,97)+MID$(A$,S+1) LOOP WHILE S:NEXT:C$=C$+A$:END SUB ' Msg #: 875 QUIKBAS Subboard From: KEITH WATKINS Sent: 04-08-93 11:39 To: ARTHUR SHIPKOWSKI Rcvd: -NO- Re: C TO BASIC CLS:?STRING$(50,178):DEFINT A-Z 'Created by PostIt! 6.0 FOR A=0 TO 6:P(A)=2^A:NEXT:OPEN "B",1,"CSTUFF.ZIP T$="abcdefghijklmnopqrstuvwxyz":T$=T$+UCASE$(T$)+"0123456789#$ G"qT0aeO*GbaqSJvCrKedGBbC*cf(Wb*d9etUq0td1GabiXiuuHn3GwIAUnpfyGet G"quX2B59fAzz7BVlidRClliPlAg#V7Bb5CPRCR7yPBDIEpxq62YwwYe8Q6f17Zww G"6csYgw6gwqAw5#22cYPM2Z62WYwqo23Yw2wg13P9TUX6DAsEpxx2qfsfITL3Yzy G"LXibzANZ2S2JR5DyUwlh6B6RDlz8UBhO11P49Bnt172sx7W9szDBRtXUya$bPmM G"E$w5qExSP5ETCZJZZ2W0L7wWtPWSX9D1DDplAiVdL9HNU5foh1rjCddqv$Dxg41 G"UnnaDo3uypNkOhgM1OKkGVzJ6HVUUb5fB1ePAq751sxen7UmWAlP6#9zbPCK699 G"JgPUzlzeQKmhRmY3nhP91XXimNxgXherFoJ5KSIvotZxYEQHZ8piBBAaZMB1G8o G"7VDtss2w4ONNuUhJ1R2vj9dtu7SW9f57YSNR5UmsDDPZBwNx6wgLvVVeQrncG4a G"7aTdTs7MRUB7BC6j8k9TCjtxjsId5XD9YINGqDwS9wD2Xqib5Ebjic#FPkIcSGj G"rHGx1CX7A2MNIuRYx0$A9tUVCedYDWFdyYEcYtkZtCgmo3dYy6I5ql0ycYwWCxM G"Ueg4bezbZybh8yMgimdtYkJCJx60Fji6pqDk9xM32kM0QbjB#RXFQ#ZCcJ4v0B8 G"89oS7a6DF3XxgMJW8YIPf7wUycdfzIZcXpG1HnnRXdNc35MS9ljJ5n3mg5pLy8M G"PgBnrpb5rY$fB7BnMZSRSWPq66QNYq2lBAYtR32vPlh6tzcUHgewfrWvO$FrYvP G"Lri0JdibgldAov#f73KHziTSzw21JKbIwgew8nzUAywgXrAFFGLn9Enlde5BmcJ G"EUXqziTSqXQ0D0L1T0z8IOD6KgA4SmGPmzH0Xb72Nri1Ynm2f0UEvBObb3TYU89 G"L7MDbCww8iCQn0wgvOtSSjKaYVfUJLnidHLPUE1P#xqKQeLEojBiVkEtNePtgyb G"kCp1YqGxRh7AwgeRlC0Udcz3Pl331nmxHm4gliKfGzSqkl8Xql1YXkgHH4ndS6d G"duLyzGuPhklZg1P275lfldHM5UToyMvsnuPy8LRGhw7SYwLjwsdPMrLLQyX9g8V G"S#slvSESWrPB7#f9KvDS2X2OexfDKrJJCJMNJXM$CoM$C4CCA1CoMWq#fPAthgD G"L1u10XkNZUJb5rc6BZoshcevNw9WzBXdbRdbvBd7#oS#GYu3kkKvCsDEkCHwyYS G"LYYSfGZ9DBYLwrgjP35XNxl3DunbBSNJh1L7edYfNjToL5oQgrBQEJ1GFgo3m3S G"cIxD075QJfxOGmmGXazqb7fIWXXT6i3VrxTQMGYbciJAmusHTDbYqk4dzDmG2E6 G"A26Oa#nz2ADkIAqrXhidSLHwALMnBazKOOS4PazGMqoqgJ7ql1KI7qq3II7qdTk G"wxw#bhwvZAGXVRXDqSm4ov9GXTxP7IAWPT32bnqhR7r1Kjy78eezulXobLLmgOP G"obKPtvPw1I2JRhIK2gMvsHBwZ2c50Yzs1nQ0x2yYe0$DDedZiX#TFb59DNJ2vd0 G"icE70Ns1Ia50z5wTMjugHc2xw0B30JxCZk8WGnn7QDEk$rJU6U5wS4QdLgo8yhl G"Mybzm3XWYXilxYVxBAHte#Co#4W9W7ZjcR6hNsC1ifviY4Q#zofE3SJWq#AMADX G"7Jf2fRD$Mx71zeWRGI1075G#GCkPPDdmPqD0UmbLiRe5YvkzXooZzkAK4UAmayf G"ByvlljcmkSSq6ragf3vltmFeZJemgVDOVMkVp07Oeg18mhmieNJfK7LyzPGBqNM G"orWh7r4eVLwf6wrxz8Hd0FyGJ9nnOyfPfnOePXdT8B2p65$TqEzx6geyl7a3ipM G"qVEe2WRehL98ykdFQmjSDAu8DB64IhnSi0ZbhrGaBWaTriu5ILeUKPVWeJdCHsf G"AfduWjwGd5ZD0KPZjokplob$yUx1Jg3TTUOUPXmoTNRTD4wt2fGDv54Z1fEwWWw G"1e8de6mmmqanP3SPZUDb8kpWneF0AO0E6c9cbWGTIu52R5kkDHbsGkvOYk7Juug G"qAXv5$CR3uMDDh5SnOmIu5ZYgbKDvvY72uOJBSGt9bJLD$#Kb5aT#eVfcaRBtgS G"4nBDcv30uAWcmmVAkdAqzDqpbecGhorWzagy3HoSaAndoEHuutNWWKNcqAeMSdn G"WYCMJeWbd6xnsvLoo4ZJjo#zdflHpH3DTZ5JpuOE04bR5h#8TjEaSYuqOb$IXhA G"yPo70PmvOb5itbJZgyMjmb30MqO8xvtElVtaWWrDr0P6#QFr9Chhjm5yvwpoDkd G"b9otycoT82wgP7NX2nSPwk0RtJpMwIeRnlAJLAK#CR4SlanC90ISlm0ObrcqWoh G"yhCrGO$YRdAbKDOdJSdG2RdO1ceG0Rd6xuI0qT0aeO*Gba44KvCXuTqzdcx)0Fe G"(qb*d9etUGudceGeJqrf2CdAjQ528uGbsmbrfBVL3$LQeKGCOpLPUejgVcUMSLD G"UJvUPvmfVbPytRBdRCZlih7BzlBl7yPBAFRBbPzttYlI3VvUTnS0fKXy9VHki4n G"iZ5lNjmFjoVjiB6vg2nAAL7C2EB3Yu869Z7PkFrXZruTA$TB2Ft0N60Ns1Qo1Im G"9i4v6B5whSvGlrBzdlzb5E#Nb1R5rWAqkN6vQRSEJsZmnR5IQ1SnVPeevlw$hlA G"a76P72sN39D83mGL9eKNuMNaTtqo10EM0UDPmbPqC7Ufm3LPlHbwXqknlygl4Gh G"Z0aHzyswt3YIx6yKz9hOoL#lZBBftA1GKTPDo8NO$mOUy#IEJNV3HDhqV77o#Y6 G"rMwZcc8SQip9mpf3zSWPoVKmHy#0nVWTmkzk$PHI$0WnSNTmntNMLGLpzDDtASp G"d4IGzKp3b#Dy8MFoXr5zXt49qyB919kZwoYY6wYu2LtagW10b1$9m0IMR#Jc9is G"Wn4sf4wzFKABajUB#336nLzx3bQJnLyKnjzfRCKDfbljJtSddMVd7CIhNfIFuXo G"mT5EoM7YLofVFRzkYCYyE7Oa6e9eKhj$xaEFRXCMDLfIEKUUAUmK9YMMg7dYW6M G"56UaZyZM#CbHQNi4k0$ViViz4wM5MfApOCaJLbnNk$I9BYWmKw2ml76rYarldcF G"MnzUAywgXrAFFGLn9Enlde5MQPyx35gdLH0YY2#ghnDzOT24vr70P3QHZYaMYKf G"shhHEFgHul3Wyxq76LB8UH1AC3k7sYOC3SlGZYIOUNJAdTLrvRhlBcjG8BH7yzd G"YqyzQRxWvD8Ii1SXVQKnKxfVPtO9sEBw5#22G7jwgcew9yxZYGyDHJ2Dqi7EY#2 G"76gMRqgCJfeYcWmwiLf#yRRCLJvmcdXBgy1hgTqILbsLEOcckEQBjXE$3CP10zz G"i0m3T1bZSsQTSn#r675gw74MpDFJC1PrAi1mQSuPVgeVb$lRV0sfRhlCu62UFrp G"zvhRDSnkXvrhz04P0O55yIFFhNJ5phohNwnNJjmKFrQ20HrxznvnDSY5S7yqEKG G"#2SJ0Har1PvpC2w8qW6qq12WUVtqmZKDRqHSItQZtHl0ctMTuwMTaCUVBtU0kYi G"j9opsmA5UJQjieqBMb5IZKwNYChvJOnvVXAWpdNBgG0oFv##SZvhlUqbzyaJbYG G"c2leHJJFdYZ#gD1QAckhiGmQXqjf22fidPG$EitjE6nBDua$MmBTofrnOO4dKb2 G"YqlTsZAsRCDpkklEkqgOjKdKX4o0snP4oe0TO4o0qRI1LLFWHv1Sgy87ACheldU G"tvpyC7v6UOgCA7TDqd0X6Eunzc2opHZjG6tqzjJbAQtaz6uvQvTO946XLDre75K G"JN2SMTLSHaBiMGj91hMmb9FxhXWwNvT#liVV7C0UAGgek162mqdVzRtk6Q#f1B5 G"2gcAanZRiObAb00b9e6SaEIIGtlny3bjnaTMbNzIIA6eggzsHIgbKDGHkZzooqd G"g0V4DQmH4GppM4i1gklopH3DTZjjafQhg4bR5hObRpaWImRUfIBtqqWJ6StNYuH G"gKJmLgFR1ktycc1MqO8x9jVL3jay4OUi6uDF1VOEUJJeMrEkRhtClD#9otycar7 G"TTms3pdvCZU9BOnA4057XCjsS2SOnl1i95wXzxaA4o1ISleGJgeVoWohyhC740F G"51bTaYo0Hr2bq71b0Uqdi96G#fLiyp23KeXHUa6VnVucLidH8jZhHO2PxBzQurE G"ogrG6q2HdXXOXq5oiiUcYPqTQdUTBFZfiBCLgWNoxCtNwvMY0umLq1Ilm8WsgUs G"X12470qvZJqrr9S5dGKn6ShtfiAy4OO8acUoGWW0LhWryCWFDajQJKObEHwS3H1 G"HhobkoCSomcGOPJ1HjhSGI8SomBgrBEwhMzd75vCjNlAiQQXGb2XDmc9LDSyn2V G"YtbmGWD6kk8Raycza5A4hGgqT0aeO*GbayxrRaHPzXZDag)uQ*c*mfuwpvfvUGu G"dceGeJqrf2CdAjQ528uGbsmbrfBVL3$LQeKGKTHnVVTU01LOj5niJ5lV5lXjoq# G"n7BLlijBzPBytlBbjCd7zlZYVztRBtlDt7BDZ2Bv#YgQGGRhH1TU3nnOyfPfnOe G"5#ByPmkEGT32WI302262wq6MH3ITmoRFRzbjAlByjZ77ZoxqyS$M7pTzoJi49CP G"RCR7yPZ595c3Yog037z6fZ#yrByLd3ubpvHXK7i6uS7HLTYP6ppQVlRBPd76Ysw G"qa#IO60ww2s27MwYsx0q3Q0$6625M2Z6gVpPzGNChDVi2tQrHI5iKFp232MWUww G"DoIG$5GLB6SVP$kz9yCYok8Zf8EkOp9lsMj#Mo0hpzeFhMIHuWJNCB25eMQ0NVf G"e3LUoRRbjrfAqNArb5p$5psM33DSLH2CoStlldorDtx2w2DKwqACnDQZbrdhAFy G"cYw4hPgZGN9JGW3c5LDPBqqRlI30Pn3SH8y0BYYIhW8Dli#B4Hlz3I5dUdgeVdB G"DzlDeVRbulnabk*e(LpzfxKB0QW4G*0c)q*WqpXumUymU4nIrn6ObkibGyHmeeJ G"HnG4fJjIbHjr0iqjmr8iYiIpHmrulPjIxPJKqfbeHjaHJ5nSjgdSG6OHT8Lb0HU G"0fObeSjm55n1Ho6eHevb1eMLbpLzM00LWKGQrLnKHSjnUznUiPLjItHk6ig2yg4 G"Gg40MqLfhfToLfSPQIzmLrTVeHaulnabk*y(rWzfxyigvEvhk)Whb(G*WqpXumU G"8Kqk9(smajvyZj4KJA7XuNU9rcgeWe0uU9wEFaJqaAWX#w2gtxow5I4d8S30PcY G"H6weNaK$ZmLPjvOdnOPeXfy57SmzlorSbo#qhWHA1BAzPG8gKOhvQpTQqnHd9Pm G"nMFLQffRuLajprlAb$krdkvdkbiwlWZ70Pu9FvOtDQdyy$GKKKunRqTOt5#lQqq G"2tGZp1S2uHWFqZu2LiM27rkYh4ajyansYATbybnyaXsYQcb4bpyabqYcDpctyap G"qYoilmazyddOOswpVbv4cdOp1KqEb#$b#Fc#FbAvo3aZFGbuGcmaj9anGfnGaNX G"MeGk8RFnmB5PBDNBzjtv$xllEtlDK6$QzVRCo#YGSdNJ3T01SaSJWgdC7OTSHLS G"c#WHHO2GFLoEpBlRGBCyvAaJmJgk$RZLUYDSWnVa8RWEHaGkpzfRCfCKdlsdy7z G"Cd8AUrhlAxd4VwacxyBHI2NByzBBfmRdReda6Hfl5HDyuYVugNbS92gM1oLMsRd G"5g7n7BHZX#1H0C5bOBsak4BdsetaJx0bm6G2dYhYxWiqg0jiKgG3waYbCcsG11w G"ZjYWehHwLHixGunGoeuMN4Evxm7XfBTMgxVQvZlN8FMFqRMWwc6tu0Rra2qcY$$ G"BqbEW3wN28PXVNHe0#$hyc1ITUM1SLvUhKG6$$b6$t70b9nkoMApIg$B4hWrtpi G"X#eBu#NyR6$fcD6oW0BbSDgGnobvBasMuGLLtzpZzPvfiZfPvjiX$yNzEcTQdjU G"b70135zcQAVhWtXAkh5a0QfKNGEfJ9afGoIX1nPXi2LPjpUbWY6$TR$eE#f1Rwc G"Aa$2UAsg#sotHREqA1bs8oK$eVbd7hyyxGCEdvTuVwLQM2G7e0FQQ$mvTlGQMMk G"f7bOiRJympAfqsgfzJwjJTz2WDp4fW97J7biFCJQVJJ4ThXk#i#0LM$Fr$G9R#r G"kFutDeN4Ezm22f1D6C6p$$NiNBsADFTkcjoEgEMNMOSBM6AKpMHN5r1QhK4o54j G"UsCtxeJ9FmSRtoZ8yeU7IW9veUNHWDlyTlHWVbg7hyytiTUescQNdWPiKOryobL G"rfU9bqjpbuY0eHi$wiYEaiYOYM0Hamif7py3QIDiumpcfZLqX8jumNcfZRqXClu G"m$cfZXqXMBOf3$$$IsOrIBag5#W4Le6g4fcDd4y8PCgtJEVU3KJUUOJTHDPnSZS G"HDJnSdSHDDnStRHDxnSJQHDrnSZPHDlnShj14iYl6fs5rUGC2$JUZ2jP95OSpMH G"9UmSFLH9OmSVKH9ImS$JH9CmSpJH9wmSFIH9qmSZHK#jK0oeu2zyNidMXrgEEKb G"zj4amkKbAfEtqReYW0Jm4gGmqhM40JHmaEd8MOkwFqX#GnXBA$HNrlb8mSuLZQa G"pNtLBnpW6ukB4uQgoLAfOuivGsrzCk1VMYtRu1w6iUWyAoLft$UIBtaUraOymhb G"WuDhcRkJd(ZdjaJlafjaVlaST#q6Db8ha5ANAaIsa#AaMsa#BacJuLbymby9b4m G"#SoaNAZWaUJ8dr3nzadkazzafYHEz8hG4mGefG#OwmD3ie0uFapkaHAaOfUvdys G"bixdqyVyditbyAd4tb4Fd4ubyK0ema3CaZsdpxRa80bO05whqUcWzhWUcWChqVC G"2hWVcWIhqWcWLhaf3JEafZCFaQfU3dyBbaDA4CKoaD1ouGYjVwGZrtFbwxassbw G"vqlkQ86uaprylZteOhGNixapraTIg21u0a9bu08eu0aA7hzL1JpH3E9JJrozMN5 G"xck4oQZ9c5gCbbf85mS3MH9ZmSlg3WzPB3kk7sXnCtm2rkNU8bqFiIUkcqB$jIU G"0l0MGMES5XMuYratMEimf0e4AwhV2wfaPlBwzc4KDc4KH3aozyQgROHekod1C2N G"0CgC#naYfWVbCa61VM8L3yoD6nZlhDAMBDR2qMdm#K3lLuX62WJQHDrnS3PH9mb G"ehsEpXnKYEGuE8Se93if2m07xHEpi07#iB$fd7PyyFed7EyyxdPFeO3pGYMB8#d G"Qt6UbEys8snsb#aEyItcGGtTaQZWtef8c2JfHEfP8DKnTH7Zz9izTa3dhVfiFbO G"xfyFbizf4FbOAfamRbSajmavSayOSMfOHbiPfaS5QwGjgGWwGrgGgxanXa8NYau G"8cSYae$c0sAPf4Le7hyMsP9aGZdYb2zaw0bGz8vhiOmDEGHs14bayDFh4OkspWs G"dWepqtjB8aBLu5FYu1l4peomA2T0mSaMj9WcKaDu0gWmVXcSaFu4lOzEKf4aGOy G"MtZkZZNQGnft9(O4CLtXAZmfNxiZWsRqMpIEUEfM4A30UGsh0rAtwdGsAanmBrW G"5fSf4OwGdMGcuqBuoTVzJMNgyv$Vd6K2dInxXkGewdWK6$vqzKhoeKhag7JHN0e G"uq7uwSHPJ4g4y3SSnSNvbhlIu9fu1mE2R35oOhclOZgXXa#$ggWVtj9Zli4Chrc G"FIA8#aXWAo2AA#88$C5k#yTV7YDdA22sx7wMmx3argJhXpSciOHQI25TWqzY#b$ G"OHEin0JGH2kSyeTI3cdubW5OkWPPWmEWoA$1qu7huULDS0npNiJ1XHZMZLnGck3 G"II7PatBZ$khuUXdUuW2gtBeMMshU14fniTejpxC1nJPfGX0eWyAdymncmMwbgtZ G"aJPDW9aWoa3tz8nWyAh2xq7LjJBea0liJmTKfWSjLWaAAgUGegWYC0tsPNscFLe G"Elj8xs4XKWNjHlx5bVjHNtcFNeEpj8Fs4bLWhkHxuc$O4R8yKFcwdo382wXqMsR G"gbs7FzA1Hcob36cj0ozl7dSUL5InTKfc0xi0hMxi9ygHKXLPeupCi$m1VCK9VSt G"O6wwk6NlfMcfa1JLTvW4Mcp21AHRPcA$cjt90VwmKCABZWuP6AiOZXRMooi1YYr G"bRaBiUS2bVNTVrUhez12XQUUTTSKWOhTP9SOfLcEaw$DzrXH0omkoI2PXwfkK6x G"qb3XrClkppk8MmeGFyZlq86o#2#MRhTbPOl5ZtKZYvisVz8YP2krsMH2sYxa2oY G"2IMISLK3aLlNDitP2gYuTTH8kG9EBS4PAwncrvYQCD7zJHYiLHYUD6xNBA1JYS$ G"nLzcTTMymZIeK$tgJdiCzzdtWq#egMbW$TF1TL9UZ1iSMaXk0z7qcG3d2vj#$kx G"tkl#AAmDPbGLa2NlnHyT4TQ1$uWAbvRp6cggBlr1FcOLQnxP$d8oG1qqLVcJTEz G"1$Zk3IQKNP1GHWGsypwA9OqRHUGJPk7LjRXfqwtpGSMtGHmul6xxa5zBx0FqxqB G"xgosUmKJDmCSiRR4gajJJTKrJEauojmoMeczJzxLSRrqNBaGt1Vdg2PdxC66I9Y G"cPCyDliD7BPlikdkiQwbrpxPLrN#pxqiS5QXKo3WGWTKY3nAdekCBmh3tYK6uIw G"LrilylzQIPhjiOhBnzRo7w6G0I#S4ws9#mHdI09UVjCOlVIYlNUa1sdqGc,qVtw G"XfgV49Idd*m*i*m0tmfJlevKrofutfbYqpXumnOWvj5erpD1qp1eubrvdkqurtn G"Kujbfvj9KtGCYqpXumN0GcA0GcqT0aeO*GbaqbNvCHfeOoF#h)C6b)c*d9etX4s G"tbbvdceGeJqrf2CdAjQ528uGbsmbrfBVL3FQ0nSJDTGmOSLTVDSHLUP9TUfK9eK G"X0MZeN0eKInV0TSZTHki4nih7BzBmqUT#lx6csqe8Z0Y62Zsx0OC3PHTTLb5wWr G"COSnSZX$hKWeMWmM6G4hgj$ZCO4ejCx$uMgZVs1IIvQmF4FkrlI8Py$sEhtCctA G"iFL7HK8HnMcLiLlcEld5RlAtRktdkvFQu0pCYhEziFhgyT8Rf5CqSOoLi1Nugof G"R#uOJMifVds9jnAqIUY#WlZGwuK8DAHo1PWoySUO#6zWoAAuvsNSUMjVjil0IEK G"1ru$KMYioHrRHl4m5JmnHzqQkZRLdr#a5yIdKmwSMuJkKTgsYh4eFijFGDrKpaR G"RgcYh4eFiiFGZvdb5d8Hcwdysd5ZWAG8qkhcynqs#ioeSgijF4WAaMdbRbOn6cK G"KpmLdG2Olqr#6GqjZD6ucvapRV5tktBmFZYqIuIkLSgInDQhj#4lsYFmOKzAFXh G"yxZzyiHmudkrIpqRqshJhzH8bN4JinCZyoKHaLsyiJl#WJ1N85cEXhe45cEXhe0 G"5cEXhzAKia5X#fwoDBBtb7fFGlnIp1wOd6qxY4GI1nA2#tLBApBAGwEu5#26chJ G"rX4MhvQpTQqH8ju0EFw5CWQbrfRMUYnVGeUV59LjRQHzHWMtuCyWSbulnabk*y( G"uWzfxS63LTMzy)nvc(G*WqpXumUuewf9(smajvyZj4KJA7XuNU9rcgeWe0uU9wE G"$MQ1MgWjCStGH9$$VH3wxtcK9bOdOHDh#rD7qas7e28qI7aYeINQOnTZfKWvUV9 G"SYnSTfKJnSU1TVLUGuU11TGmncprF6ubzBFlzlRlBydvijgAKoTOfuHSfGceGVu G"W8uScuGdqV5yFGbWyB5cUJhbjLJLGDWcqXcq3fppbd7b4FujV03iaBWW2YkdDTa G"HiaNzbdydbAbj4qFktJr60iqV9HguMY0PuMTQjcgWtEvxm7XTcbOMrOb49$Qw1J G"OvOay4lIZd9euMEWehHj2O8pXw1$le60DGP3cy7ob7j8c3b2obvBa1Sqlycs2fO G"JnihjOjnUbbRaLPjpUbc8JW1TR$eE#b#QLGgenvVMzFcXG5odmFpyUswbsLI9Yy G"Em9LfaFVz#EqUrnL2s9OvkAvoarlzUx119GOaUFaDpU0Uh8K7EsXCVECJQpLkI3 G"EeR4tlF6uC$Fr$G9R#rkFuY3qasCVApN3Er9heGP$8$tSheITK#eHRVtCTf7fx7 G"6naCTLnXN9bPy$Haeef7qOyEekMlHI5tOyofkMxHI5wOy#fkMJHITR0AqZ0sl0i G"rSBT7SCgj2odK7hLDTKbaDt$o6gAHq3a#efevKweITIuagg$#sfN9KW3AnfaFZY G"MBL1Ry$kf7d2e6M7VIgTewFKu06fdqrd#tv047POHoafnxafnqTYcOObFRkA8Gv G"0qpGIMNGIgOoDbye5Zc31q93U2RFpb9ttI#vTkWHCnPv34ghqUJDnx0BzQA75Qa G"kZAxfWZL17vbK1inqwVwqC1y8UZGQXkA0aPOvO4mb5lfYf$#Q53iv7a8BGUM8BG G"Ab8BGkS8BG9x#nKpPpRE9RjFzx6GL$JcW6e7r8dWKMOe3d4Ufyaz8hhm59FIplb G"X1tpumEfEFOvSBaHtuFtYFac1ftClcvn1lqXQHb$O1zaXnpdOhEMgDobhQgCDo1 G"y$a31Aw3emLe8$2mom128nd7TzyFnd7Pzrl03ft1oe90hG460CBK7U$2DUao7do G"ad$sG7m6w#$BHPFx3MpdwtZQo3$$VMeW9eG1nGhXyLUY03wmGlo6lE5Z30lw50f G"HZe4Y31098RVd36FWfF$p#7GgWytqwZYGkNqbdEjDSWYFHR617El#XH1vrLhGsD G"XuhWNs8Vfq2NsqElkL5IVqGJ16cXydKH801G8uG11GXgHi8rI$sZR11IwpuqFUd G"vD7uc6qPAXP8MPX6IDOdj44t5ITHvDXonNGmw7ZC728$EKHeCUfySpDrQBdQNcu G"77YkBvltVVXib$LWJ#kdaKjzmaxwGOpZKVEnySNRc9xVeo2T6vZ1C81JGKPdyaJ G"QctEDLOVPzb$LWJEUGptwA0XWDFZbK5kbz8GOgNLg8OeWVMUreRkK8qTUlWvjkL G"RBb#vstyhH80BAVUnGKvmXve0XfO$Qx76Y8l#busMxPdFN3FUoCWVNGlUGlSOcK G"UY$$Din9W#eiH#wsOjt3N8X$PtG$EGtoQahDTSFXLtOhx8F6HQ$ZQw0sVsSlhpb G"7rbhGY4lE8snQlt4dTFdiqcQUtNEyu7TlwERot7Nlq#ltYZFwltWl#9dy6xv6#a G"I#o$pQso#WkGJDVU8hBqdhGHhXbmu6U7ypqfFXW3jgHbmFC7R79TzIT5CdOnzSh G"U93Y2JOQydANWbCMs$x2pRfQcbED1pR5jiP7#5zcP79yE6o2J6eNv25SJoNDQYt G"rsxsYtUCWDHUE0XgpiANYRpPDcoWOV#RV4Gh90pXOJ6awxNV#aqFS7NiBxyStdp G"2b$3yhT1x$NA8pX#G35bE9Jg9Zf8l#4du4aLK#h9qpGZ1G4IM2P3N9FuC2NylqA G"$IAOo#DSWnzI$Pjz8reIpmUy0LLLvwRQ5sx$a6sRk8c26KoIGmhCx7C7AxlbLFc G"QsvvqgAdcBUoVOVAfNv1XL3dBrW8jJiZvb3#VENIidZ70D7Dsp9UgTGYCf8byf6 G"hZUR4QYPgsi0fdDWShHE41uzubJzSx9x51h63SDZ$Vj1zbm6in3OUQVIoNC2n6I G"9F0nxWJERdq5EHwgJprRno6AuxUmC0VXpBR6fDJ5GsPY403s#V4NTKAO$lzg#ht G"64R5IwK3O#3K7aNxlXDyuoT$xhFUCDE#NIY5SC94NUl0XEvFiPosukp$yt0IFzv G"Rpmr0k$bCxfaGwCCJlWh7og4l2Qg0xeQ36DkC6crGAz6YWl5wPwwz1G2RF9wAQZ G"Dx5c4D9k2YPXE0x8$vA5FuYlwFLtE$ONebnRWYNQhODsrMCRFHEQ6vd8ymbpSdv G"$aJI2dzm#4cUfqNwow1xiYiCo$hSRdB1ylKJZm4pglydnycpidridtidv4bxGXB G"XgAXh8G7ggrjkrbWX#G2WHkqP2WP2WR2WSUq22aomdxok3eSNhWkmWkuWjKWnK0 G"l05c86l4a7i0IJUh2j3gGM#$Z0ywrNIBkJLTVBcMWCTJjeDFJUuNhKUwCOdv83N G"NtuUeKNK0UkCO8Kxi7k3UbCOUuXhnGyEuc9dBWNuZaMIkpbgezmYVsGN51NrirX G"3c4BuIBhp#UceocYUb1S#zO5tqzlV6sm6HY2qZ5ekFeSnXtpbKJVyJ8lyZYWfJ8 G"f8kEyejqbrEdUiO#fk96#XE0wtxnWi8bIC5srOoLpXro6vZG#ixRBfRRm4dwBDY G"ZZbV$aE3c0ehWR7W6LF$ShfXnr#g48VeoFNpxUyCGzFUmKXbpWblP3XbtN$RNeO G"Tw3rVE(38jUyNY$vImdJmE$VrLzl47rwjy2tnde9zGfzI0#FZhnLnElcjNU52NO G"kKbckBVjethkLOKB9XLdTKlRAhbvtBZftezj9L7m42r#d2tDu4K2GtriVa$pnm9 G"gYqGJDj#Nf#YrEkk$bI9asaI6fSiCHN#bDwvulxOu0iNW9UhTs8lQows8wuFDbt G"MspDEv12h8vkmRMO1Dft0fOk7CEbHmSYDTWMuAW1r7CDDrx$6j13BsfFGKMrU3M G"usUbi3gxP4qtcFzuT5igF5PxV$hWmvHGOoV$KtvNTtFcrkJBmzZYr$xIyyCXXFJ G"gdBrO8hOUMRzl$WsNGvg2$RVN5xPxOb2grV#oT1LdPft2G$iiSwHOwW0LSO6w4G G"94eHcctvUfJrneP7uxmtAzmdy1NHcKKVhrINS#b#DDXd8XmJ9YzfZfWZi9srnbR G"lgusEDfAG93xhOwfpPwEtA$dPZEGKAgghZY8g5W9RoLR8Fwb8zlLJAemB7iRRVm G"1MBv0tgl41Tefv6SWOn3PIQZkxOjMIlUQcuPjMkHCVKrnkfPwYz1b0UxaAnReNp G"7vY6Bsexb8W11wyrJItZmY4EBzw6XNlBJ0ChkR7UebRBwxU3R$zTCKyngzEcq4z G"j66QxywxS3d86qY#WqYX7eAoNYraHKC6Tdu2jGY2zvpZB0Jzdv1ED5ovAPmrnqv G"I7L6iocOHPD7vGDWXCpVZg7r6DrildlDzklJiDsn103CaUs7BS3WbqG5#7Odg#v G"q6kG$H5VLmM5qz6wL650b5Pr9#kPlhz5nyCkDJRF9uhY#k3j8nJ6IL8jiH#0hY3 G"3yu11v8dIu7bBE$HT5BDSIEa44n0dSZ8a51xQL5eBz76ZmUSJTPRwr3GKHvK3mG G"W2Q9TEV7JoSJg54gursC3VqixyDwEb5ZILJp908hXfjYFVIphyS66exKZCe0Q4Y G"#cqCV5lI7PFE$cEVJ0Ej1dAcUB4oavFEc3nDhqRphlvEiQn5iXXth6Ioi#vfGUb G"pe9jBikirxafrH4k7io0OlqJxWiWZWYuEkybYq3WTULNGFWefC7$6rgGF8bFy3n G"PbkB4laMZTaWHD6shcbd9diUcymVE6kH7hXfijlW9eva7TsueC0e3HfWD4v#pE7 G"r4cU9UUiOoNT1WXV$lCT5BBR1KCa4e8FA$GvzFd#8O86y7qZ3czUVII2edPe3VH G"ekpo0kMPluLTpQAw6wSSpi11ZX2rxnzR$6m2LAPvSz46v#y$jcxkk6diax2rH7R G"VoL6ef5fmH69T7FWgNH50MSDGY1cdrFW0nEs51SSDyvDWu2#Y$9JU#WLLnQyF6F G"SAz1FrnxyeXHS7Fy#F4dH4qH4BH4DHiOHO0HqHano#OD0Ap5ufPi9DeB09tmvPn G"jRteXP8#7JUBaKUqs3NFDh$PVwk#J3bYsqYtSKj8RtYheloSbyShGl6fq8FD$hC G"PJU8DmDZ8OpEx#$tB4hQivbPB4O3gishlRwHNWBpH3D318hKaejip9x$MA92$8S G"fN8gqEsj#oMNRizgG9ecHY19aj7cm959$8CekZbC6D7$m2ry6p7$v0RWbC#vzDF G"ahMhqw88EX7JT#5pi8HPmB3xT93Tcb49h$adMA7PFN$tTJe#wO9mMhNHOhfZRuq G"r1Ghn9Ghn9txaNGkLngfhIRxK80ijZKvhJ80jjR9B6DipzsYm4EcuS5uJD$fVs2 G"6SAnLdiptJXEJm#6ySvB1xkJ9ez84Xy7d788ng7IY4htlN55CYi6ULUrLNWLUGL G"NfbWBEEeiRt$UkRRfAAflWg77h7FlEqv$e7KN#4hajEDQMo2LiJb2IaRgIp4VJw G"H$o8ASxgVWS3P07a5YGhwBuWpnRRm$h#5PFyTVyfWxWxT98IDA3jEFv$593YomK G"5n6LrL15OieG1gT$ySUWas7$FWCncqL9srMxU9x2$#Q1D0dBbeTX8s2$yz6Ewb1 G"O5gEY#xN5cHy75EhL7QKCNhi3R4uln9njcYG8Bm5aXi5mee5#dVtVIJ$3juLlpA G"FeF9kSNNzcoo9dG7mr1DNWtFRAblsoeQvTNYjiDMJ7HwYpyJ6amMbAThz$as2ie G"AABY#5IiMwRBcC3YaRu26G9$zuH67LTrnj8OwUQSGWgCVGh5j4bWJOFLhNQsnLi G"Fna0kbiV#46RHrwOdvSFITMhbQA4LyLZlFyk7OkaF5rSvNN52NVXnBZxfWZocwI G"S$07ljhN1ThanBvMpajYvWzPPm$b0Q33fy3YGZdwAeURn3s77bAZmpp3S8$EiwV G"qT5Nv4r4KdNxxALHZ6t21csJEGgG9Snd9oC8gGVCy0z#t0a8ccZGUUWMogBBgSS G"TYBH#2s7GWAdA6van9dG26$eaTdcOz222gJxrY3NSAGvZ#O0T5i2H4ix2GeDxUD G"c6hyVxEVEdF0hjkikBdM9nOyNaFZHj63maZ6xpWN62rBgti6Pn0UBqa0V#o0KT6 G"xFhomK5lgAdVKAwm3IzpcrF6yjTWQP$Wrp2WvgFCo#aIq9W#CE4yIVtJGBY$$uc G"IxiAYfHbBXXnPJOyVQGeABFuLsdZoP6f$Eg0CTMftQEDrNgSp#neJQcOgF0Qzc$ G"Sg9aZe14leBW2$v6iNC8b#dF8zyBAflC0tQTbB$V6Kme8Fv4c3MJrh4Sp71OKOc G"F$4pjHxYhE6eeM8mN2jevQ#R6flCNUEST49Zpk$hMmbyiezqkU$8iBzsjiIBcbr G"TUXZxKBmLRJJsueGWNnX3Go#U$CzWiSXij2LCnngc7nWai$JbqEH6A1QCqD3qOU G"EPxy7lM5tbcnggIJsi8mzqUqOPdpGpLoV7FKEGfl9DOI9Jp1MTdPMbbaWG2Vnqy G"ysfqUYEPqSJVtdxkAO3j8kh4aOGYt1p89hhWkhch3G$QG4m8wemxb7B0cFREAOu G"udfjyPC7eugb4ySWCHFa8JxYbOa$hRBefyCl2t3KywS9ch#6kXQl71DeS9$1Zp9 G"mQX193jujL9gGoTUXaw2xp5c8kX9g7v6pfI7pg27Cce0cnHGkZf8kQbKrhXnG$d G"AFdUn2UMWXgWi2PYlsB6ZJDEFasNPpqtFHbGiB3ak7iC97PwPr#tFfMC6wVe9vW G"D7Rvk0g2lXgikATRpT#7tbUIZWEoiQYtplNhF7h5izI2dff2IFtbKPUG5CSdHRs G"a7x7RHlTLcFE#j86tBCJlL0ScfPMEKwyAUS#nNEMmhP1ffGrmL2EsC0wHVRPgFE G"DW9aozHQMfHsMdsfuKR4OJLAp2r8JSdrh0qJdw9H#id2CEuzMlCRgACgy4HJadp G"6ZkpnC0sGaXjBlFqdAuu7Phk4UDokdBju9#G4U#WbDfwCRIWzC4qYpngbc2lw#j G"2S4t13h$pHTc2e4s1dbG4AMVyeHpSNOgG2LPFaGUVyURRz$7jkf4CEdzi9kf$IP G"g9bQx8wmGRam935#84TQfNN6OiX$pdqy5SnwJEocqvT0$VtBx8Od0pi6nqpP2tp G"Mmbp2umgJx3PcN7rd4b8pZh9JpKrHiBrGiRfD1rGSJrN8iuDpYvB$oZUCoaSnym G"3#HzuPtnjSAD5HzWXypYHl8UvWga4zR1DD1216UU6yC#xVjmBZKeTdsox8MSZ$G G"m0huDiM4MCUV3apWkjMMBUOIXaADrn9VmEkzBgAR5uGy37HUK9uiv9fEQev$dYT G"Fb5gwMj36XKBF9cBHH9w#TQBk5ETBc5wY02uXnF9JcWWdTGd4oj#Cp4kjgSWS6x G"g1E#vFQXOnVWjcMP8gOaShFbOFM0JAVOPZ8X7o5MY5h93nTEm0E7MU9I8Fd5mUy G"BA#bwCpc#bGskaUFTj1N7kqXCX$kd3P1R77X6h9iXTb2DlxTFGp3hW1VJaGoBtF G"G$pd1Wq6Fr8RttQLdORMFvS$Gg8xGp6bNRxcH7la$)l#bMiP2M5$hKQZeoCIHyv G"IpW9N4$sWN#0wi7DJVlfpEb80Z5van5jiJydBmToEXB8Fni$x9Qp6rozyg$Q#eD G"tidbDcnjJ7QanzI746PWHWjguOMNl9cpXCbe4pQet0kHpa3wfHtCxS27I3D8eC4 G"bfWH3$tPiKeCV4VGOhf5h5Ih#wrffK2pKFhWWFfH70BJW9sS2ziKBmvc8E6Zn8d G"e#YDKTAechEvOgjjq9ChXZwiqdTOfW0cVac61iiwP93QMd8TU4JCl9rrWP$zCRj G"ckMk3hy#a5wFDbQygYDKhbczHN$r9Q2lgANUMf936#QeNaeTpaoqojSwT3jc02N G"UpDGoFUjOlVUH$$h$mxVqXTGrGiVnzOv$a7jaQm3ccwdiU4Y1Grx91bYDroitMl G"3ogTeRfossQmi8Cey73x6Ju4sHbIbOwNBd4E4fZFC1tTE7uQw5n0x5vCHLfu#Dv G"qk4trHoq5FCcKfnM$RzDyDNtzcS$Hk5VDNa5VClyoVQ$Nlgfku9GKk#de7cNtG8 G"l7W7dy#h#vWt#o4Vl7CtER7bshMWqYrdsuPxV8WdPK#ls9rFWc$Kaw8WhQlM4sb G"titPzd2EDPWbSbhmpG6PJQh9p0Fq0dQPsC0fFTc4s3E7qdSZySnNJ#8KmfTVF0j G"2dWzGOXKlqsN0ON#5x6jM85t6fpVgJ$iJf2bx6RbUXo6KeYB9fYJsWEh6Hm1hps G"GAlOfIqONx6vk8nU9roS4Wl2AlJeOrkmewJh5XJHGq6c7VVGBvHogBcynhig4fe G"2BOPE9#I0meGCemB8h8AtjpajCaLGJYaCYymalBhp03OaoMNtnoGJ9bgWBfbXaS G"ah7h1chFIo21X5UII#aU7nC8i6zhah7I4yV2A44nXXUgyHDagJJD$9URJJ9xxHJ G"Fhh7I5zNih7g6z3ih7w6zFjh7i7zVjh767Eplh7k4yNlwLmmG$VGbCq20PcsPwx G"32sQM22wwqY00kw5gw5Mxq2sqo03c38k30Ew0sxqIYXMsqgZCMtyCc2nnTJvUVD G"UV1mtx3lx4Sq97kgEbxgbO2LJ9TSfGdnSUfKU9nzN9xgKRAfKMnTSTSaKQOnTZf G"ec70nT0P5Ko7hKWnSNb5FRB0gisx0k3YW9KmPoLOvfGbjylzQIPhjiOhtUVnU1U G"LoiTOplU1062Zeois37#MWHQotM0cuSwGMeO$6q$Qrtktl6xE7n6taLBWUsnjyG G"rJ8boWbQAqRqfemi5pWC1f8a9anJRvas5auSsscgGXHxamdVafWSlGV4aOPiJMa G"UQHRaoCrAaHfGKLW#bC8guGqKGfTOfTGfiyVMWycvGRGeKWeQy9aZegMWeMxfQh G"4z5EocblycwyAhU4fpbpcc3bq3JqeySjCeRO0T1LTSnLgyVbZVahKc0apcA4Dhc G"KBq5nSBVHD9nS7$bSeyYUWeSlZhS5OCKGEKGGKGIKG8KNobu7J6tFC9s1gqL3qf G"OP1H5HDSRj3C7ww5Aw2#27eDHTTToJTLqZonJqVwZjBATBAjJMXIrrn5TUYaxXb G"4YOMyz8BRtMAhDV6pMEdkz1pBDyn05SUNG155yDGa0L1vOSBCxA35pai20Ilhaz G"NoaYIE32nECUgrRYGOLXYddUU2s4#gUYq6RJFQWNoBnlBBSMmaTha35XyUzdrhe G"QZkYEyN7CeKsTXOs#aWAxGeaKfTJdailA3oaqwka1sdqGc*gaGMCwXf8XkPxjrb G"(GQr)g*m0tmfJld1GabiXiuuHn3GwIAUnpfyGetquX2B59hzAD7yzBDjBzbjpNl G"DjBAFRlrRpBOcMo5yPBEHBzMo8WvUVDSLDUZP6W1$wolVpd1ruKSnS59T1LouVf G"b1Xo23YMOBbpQ$RZ4Aqi9J2YgwYccIN7O6yPBAPlBKFvC76itwXkxqm8nDKNByz G"BBbbXJQJKW72y8n9i49lvjibPtFkvlQomEpeP3WnnA7M9niRzAyL7zsE323W1nB G"b5ldkt4EdYqgYqq8wLVyS1Tnm6DJYuC8EpcV0#bPrtktlY2lR6MnnuTn9CSOry1 G"0BXwxZA2YkhPlMF5Von1ZAUBwuIc5l7H8kPubTwK0zivz5cSVizPiVRyfzktji7 G"zpbjmm3tW5EcHdtATViFp0W6wq623KSs#jiIFccHfTVW2tyzXJvUrzmuU3NYP#Q G"p3Yi#cUdK30TUYDmdF95jeoipPmpjiwwtgMTLvLD3s2e#A6LAUQ7UTZ5SS#h8P0 G"LMTT01odvT0f8ZDCDCtRXJA3H56hgvxA27i2fu3O0eDpz5CtRElJ1Au0eqmLSmM G"SyUKPajtj2IOGpxDCLxuhnxH9ETPfolxn#DSIXPDZwtvD3LYTmpowxNuPRzzxd3 G"WEgRNOSUUrP7ZOvnzIIEkwB2v$Xc38Ic1RkUnNAQI20eVs47DkdFmmBEvxsjwyI G"VASGM1nYcAVnauz82amPlAixf3aGrfLLzZV1xjrk$eU8iEYOgBYgw6ggVdh3fRR G"LZM7WwPSommvDEO41wDFuMgc3KfRwkHm0uFNstCPhPvfP2G4VHw2Fk0#x5kmTcx G"tbZRNL4fMWq0LQ8lpHLONG3flCa71zD60KY5M32kgQvgwho5RfdLtN2XK8MT5HT G"PsDcWRM8R6uArX4IURYInjtQtjAveIl#rz04mRtJXKg4vpVBBDE#fBzqhPEARbT G"mHjmbPtgeTthM4Sj8l2WoNLnJT#xO55OTIx2$ZfndPMo8hUZXYBCMLWip33Kjqt G"1fI6ch7zTz5xCZ8G4MlRhfZ4FTf76u7Bqk1Nofk1726auLqWM2#sr3WohPgUzv1 G"YQyNq#XsxB86XuErteVyKuB3UgAVXhIBFnwZ3xaoDBACA6OxgxxNnss5x2VoMtH G"dTtqezYYoTytlzWo0YtfuQasDmUoylJRdnkX#mk5kPlXbPSNYrO21HrtyDXPOo0 G"yC$Acg4n2q46XFxVhkeBA5YG3UE3YymytjQZa$a1HcOvulcg2bnDV7BwSbXb5Wg G"fXc5WgvHc5WMcix7u61yyJ#pdBasSjk#UKIDycOD0G4maFBNf2QqHnEPZJaqYKd G"mfCafrotZrXr2gpnkb5ztRDQZBMLH9klvQykVGmf$hhpUqNh2WOZdCowxMvBkOV G"D396xvpULZPKOLWQVJHfHPHGB2PbM5Hpmp0KWG3WyUhJ$teEtAd8ulp#o83DTZ5 G"GLltykJeweKrw4JYiuQE0QcEgz0uOZIPKHCmuYKYqjd#YqjtpdLmQNNHsgyNJkp G"jmwYOvi0eHDdeknMUaKspLnKB0uhMcyozkiMH1mAIjD44sPBItkRMWRAY9ibXlA G"gXeeeS2feqfOGErmgjc$eJyhYUc765y8QOeB8H0i3zJoKJCkG1jOSnpidjE1qnT G"#TjBvMArX2457VjEd7LvADzfdKrxIXTO2Gmb1gqb8MxutJVBlpRH3rIlcca$2Iq G"H6ZhbKKVyplilemecoTjGHjTOnHA3A0MOTrBcvibNfcWbqT0aeO*q(WrwECb24# G"#Fid)yp)Gc*svuqe1urUq0tdrf0KM5acYmW1aIX8g3qNWKg3qq6GMYaItmKtaIj G"ggYug5acZKg2ugcAM34rjsXPKMZ4MWWgqidxidqeg3qgAkM3yhkQq2iYXqN0SWg G"OaqkYpAY2eg64cqaIKqhAYM58MeUWg#qcggqmNW0g4Cu4iN3Cg54vqiXLMq5uML G"osAAvFwgGku38XqwgIEN0irUMN2KZPYcR2M2uggQvBcc4eMZqXGshrohxquIsLQ G"Y2nwWLUvZm22G2jExro45ugkoK3WgxqK3mgkR(qTuacS(k*y(e7yfxejXa4wah) G"Gqb(C/ab(i/m0tm5crpneulfGalaGc*gaGJtwXft1cLniCb(q$r)f/q)c)Gjh)d G"9etUGeulfGalaGc*gaGDfTceMMfp3by)qPc)i/q)c)Wcn)mfuwpvfvUGeulfGal G"aGc*baq5twXf5gTkmoi*T*e/q)c)qSo)d9etXa1sbiWcaO*GbaebNvCHHyu5vDO G"*Fe)c/)G*y1d(WqpXumU8Kqkb1sbiWcaO-07KvCHXlEV4W+d*c/e(G*Kzg(WqpX G"umUqurgb1sbiWcaO*GbaqbNvCHfeOoF#h)C6b)c/e(G*8Eg(WqpXumU0uqqb1sb G"iWcaO*GbaqbNvCXQFx2AMHb(0uj)c/)G*mbh(WqpXumUuewfb1sbiWcaO*GbaOj G"NvCbFSs6vsu)OAe(Gb/e(G*8jn(WqpXumUmeulfGalaGc*b(hz5XfyJ77$Hm)G9 G"*k/q)c)q15)svuqe1urUq0tdb1sfy,kaGcaqH)qX6+a" N=15599:K=255:IF LEN(C$)<>20799 THEN ?"Bad script!":END FOR A=1 TO N:LOCATE 1:?STRING$(50/N*A,177):IF L=0 THEN GOSUB G:L=6 W=T\P(6-L):GOSUB G:W=W OR T*P(L):L=L-2:B$=CHR$(W AND K):PUT 1,,B$:NEXT ?:IF C=108 THEN ?"Ok":END ELSE ?"Bad checksum!":END G:I=I+1:T=INSTR(T$,MID$(C$,I,1))-1:C=(C+T)*2:C=C\256+(C AND 255):RETURN SUB G(A$):SHARED C$:FOR Q=2 TO 9:DO:S=INSTR(A$,CHR$(Q+38)) IF S THEN A$=LEFT$(A$,S-1)+STRING$(Q,97)+MID$(A$,S+1) LOOP WHILE S:NEXT:C$=C$+A$:END SUB ' Msg #: 981 QUIKBAS Subboard From: EARL MONTGOMERY Sent: 04-09-93 22:54 To: ALL Rcvd: 04-11-93 21:29 Re: COMPANION PROGRAM TO VGAC 'Part 1 of 5 parts CLIPEDv6.BAS 'A companion program to VGACLIP.EXE 'Make sure you save the Document File that follows this post! ' $INCLUDE: 'qb.bi' DEFINT K, P ON ERROR GOTO errorroutine DIM B(500) DIM d(100) DIM PIX(1000) DIM inreg AS RegType DIM outreg AS RegType restart: SCREEN 0: CLS PRINT "CLIPEDv6.BAS": PRINT "Copyright (C) Earl Montgomery 1990" PRINT GOSUB keyboard begin: SCREEN 13: DEF SEG = &HA000 DRAW "c142;bm100,100;r4;br2;bu2;u3;bd5;br2;r4;bl6;bd2;d3;" DRAW "bm2,2;r6;d6;l6;u6;" GET (2, 2)-(8, 8), d GET (98, 92)-(114, 108), B CLS OUT &H3C8, 0 FOR k = 0 TO 767: OUT &H3C9, 0: NEXT DEF SEG = &HA000 BLOAD n$ + ".cap", 0: DEF SEG = &HA000 + 4000 OUT &H3C8, 0 FOR k = 0 TO 767: P = PEEK(k): OUT &H3C9, P: NEXT REM Main Program x% = 160: y% = 100 cursor: PUT (x%, y%), B inkey1: i$ = INKEY$: IF i$ = "" THEN GOTO inkey1 IF i$ = " " THEN GOTO inkey1 PUT (x%, y%), B AA% = ASC(i$) AND 223 IF AA% = 0 THEN GOTO mainkeyboardscan IF AA% = 71 THEN COLOR 15: CLS : SCREEN 0: DEF SEG : END IF AA% = 83 THEN GOTO preparetoexit IF AA% = 72 THEN GOTO helpscrn IF AA% = 90 THEN GOTO zoom GOTO cursor mainkeyboardscan: IF ASC(MID$(i$, 2)) = 75 THEN x% = x% - 2 IF ASC(MID$(i$, 2)) = 77 THEN x% = x% + 2 IF ASC(MID$(i$, 2)) = 72 THEN y% = y% - 2 IF ASC(MID$(i$, 2)) = 80 THEN y% = y% + 2 IF ASC(MID$(i$, 2)) = 71 THEN x% = x% - 2: y% = y% - 2 IF ASC(MID$(i$, 2)) = 79 THEN x% = x% - 2: y% = y% + 2 IF ASC(MID$(i$, 2)) = 73 THEN x% = x% + 2: y% = y% - 2 IF ASC(MID$(i$, 2)) = 81 THEN x% = x% + 2: y% = y% + 2 IF x% > 300 THEN x% = 300 IF x% < 6 THEN x% = 6 IF y% > 180 THEN y% = 180 IF y% < 5 THEN y% = 5 GOTO cursor helpscrn: DEF SEG = &HA000: BSAVE "temp.bin", 0, 64780!: CLS DEF SEG = &HA000 + 4000 OUT &H3C7, 0 FOR k = 0 TO 767 A = INP(&H3C9) POKE k, A NEXT SCREEN 9 COLOR 12, 0 PRINT "Command from main screen:" PRINT "<G>=Good Bye <H>=This menu." PRINT "<S>=Press this key before saving the picture using VGACLIP!" PRINT "<Z>=Go to ZOOM Edit Mode." PRINT PRINT "Commands from ZOOM Edit Mode:" PRINT "<D>=Pen-Down Mode." PRINT "<C>=Increases color value." PRINT "<->=Decreases color value." PRINT "<F>=Changes color to the same color as one block to the right." PRINT "<L>=Return to the main screen without saving the editing." PRINT "<S>=Saves your editing and returns to the main screen." PRINT "<U>=Pen Up Mode." PRINT "Use the arrow keys on the keypad to move the cursor. Home moves" PRINT "the cursor up and to the left. PgUp moves it up and to the right." PRINT "End moves it down and to the left and PgDn moves it down and to" PRINT "the right. All keys are repeat keys. Just hold them down!" PRINT "Press any key to continue." inkey2: Z$ = INKEY$: IF Z$ = "" THEN GOTO inkey2 SCREEN 13 OUT &H3C8, 0: FOR k = 0 TO 767: OUT &H3C9, 0: NEXT DEF SEG = &HA000: BLOAD "temp.bin", 0 DEF SEG = &HA000 + 4000 OUT &H3C8, 0 FOR k = 0 TO 767: P = PEEK(k): OUT &H3C9, P: NEXT GOTO cursor zoom: GET (x%, y%)-(x% + 19, y% + 19), PIX DEF SEG = &HA000 + 4000 OUT &H3C7, 0 FOR k = 0 TO 767: A = INP(&H3C9): POKE k, A: NEXT DEF SEG = &HA000: BSAVE "temp.bin", 0, 64780! CLS : PUT (50, 50), PIX, PSET FOR y = 4 TO 164 STEP 8 LINE (100, y)-(260, y), 142 NEXT FOR x = 100 TO 260 STEP 8 LINE (x, 4)-(x, 164), 142 NEXT x = 160: y = 100 X1 = 59: Y1 = 60 i% = 1 OPEN "r", #1, "zoom", 1: FIELD 1, 1 AS O$ FOR y = 50 TO 69 FOR x = 50 TO 69 LSET O$ = CHR$(POINT(x, y)): PUT 1, i% i% = i% + 1 NEXT x, y CLOSE #1 i% = 1 OPEN "r", #1, "zoom", 1: FIELD 1, 1 AS O$ FOR y = 6 TO 164 STEP 8 FOR x = 102 TO 260 STEP 8 GET #1, i%: i% = i% + 1 IF ASC(O$) = 142 THEN PAINT (x, y), 143, 142: GOTO skipover PAINT (x, y), ASC(O$), 142 skipover: NEXT x, y CLOSE #1 x = 176: y = 88 flag$ = "jump" LINE (170, 180)-(190, 198), 142, B c = POINT(x, y) IF c = 142 THEN c = 143 PAINT (180, 185), c, 142: LOCATE 25, 30: PRINT c; inkey3: i$ = INKEY$: IF i$ = "" THEN GOSUB putcursor: GOTO inkey3 AA = ASC(i$) IF AA = 0 THEN GOTO keyboardscanfromzoom IF i$ = "d" OR i$ = "D" THEN flag$ = "" IF i$ = "c" OR i$ = "C" THEN c = c + 1: IF c > 255 THEN c = 0 IF i$ = "-" OR i$ = "_" THEN c = c - 1: IF c < 0 THEN c = 0 IF c = 142 AND i$ = "-" OR i$ = "_" THEN c = 141 IF c = 142 AND i$ = "c" OR i$ = "C" THEN c = 143 IF i$ = "c" OR i$ = "C" THEN GOSUB printnewcolor IF i$ = "-" OR i$ = "_" THEN GOSUB printnewcolor IF i$ = "f" OR i$ = "F" THEN c = POINT(x + 8, y): IF c = 142 THEN c = 143 IF i$ = "s" OR i$ = "S" THEN GOTO savefromkeyboard IF i$ = "l" OR i$ = "L" THEN GOSUB bloadscrn: GOTO cursor IF i$ = "u" OR i$ = "U" THEN flag$ = "jump" IF flag$ = "" THEN PAINT (x, y), c, 142: PSET (X1, Y1), c PUT (x - 3, y - 3), d: FOR d = 0 TO 50: NEXT: PUT (x - 3, y - 3), d i$ = "": GOTO inkey3 keyboardscanfromzoom: IF ASC(MID$(i$, 2)) = 75 THEN x = x - 8: X1 = X1 - 1 IF ASC(MID$(i$, 2)) = 77 THEN x = x + 8: X1 = X1 + 1 IF ASC(MID$(i$, 2)) = 72 THEN y = y - 8: Y1 = Y1 - 1 IF ASC(MID$(i$, 2)) = 80 THEN y = y + 8: Y1 = Y1 + 1 IF ASC(MID$(i$, 2)) = 71 THEN x = x - 8: y = y - 8: X1 = X1 - 1: Y1 = Y1 - 1 IF ASC(MID$(i$, 2)) = 79 THEN x = x - 8: y = y + 8: X1 = X1 - 1: Y1 = Y1 + 1 IF ASC(MID$(i$, 2)) = 73 THEN x = x + 8: y = y - 8: X1 = X1 + 1: Y1 = Y1 - 1 IF ASC(MID$(i$, 2)) = 81 THEN x = x + 8: y = y + 8: X1 = X1 + 1: Y1 = Y1 + 1 IF x > 256 THEN x = 256 IF x < 104 THEN x = 104 IF y > 160 THEN y = 160 IF y < 8 THEN y = 8 IF X1 < 50 THEN X1 = 50 IF X1 > 69 THEN X1 = 69 IF Y1 > 69 THEN Y1 = 69 IF Y1 < 50 THEN Y1 = 50 IF flag$ = "jump" THEN GOSUB putcursor: GOTO inkey3 PAINT (x, y), c, 142 PSET (X1, Y1), c GOTO inkey3 savefromkeyboard: GET (50, 50)-(69, 69), PIX DEF SEG = &HA000: BLOAD "temp.bin", 0 PUT (x%, y%), PIX, PSET GOTO cursor preparetoexit: REM blanks cursor and saves-ends PUT (x%, y%), B: PUT (x%, y%), B inkey4: i$ = INKEY$: IF i$ = "" THEN GOTO inkey4 IF i$ = "g" OR i$ = "G" THEN CLS : SCREEN 0: END GOTO inkey4 errorroutine: SCREEN 0: WIDTH 80: CLS : RESUME restart keyboard: DIM inregs AS RegTypeX, outregs AS RegTypeX filespec$ = "*.cap" + CHR$(0) PRINT STRING$(75, 196) inregs.ax = &H2F00 CALL INTERRUPTX(&H21, inregs, outregs) data.seg = outregs.es data.off = outregs.bx inregs.ax = &H4E00 inregs.dx = SADD(filespec$) inregs.ds = -1 CALL INTERRUPTX(&H21, inregs, outregs) cy = outregs.flags AND 1 IF cy = 0 THEN WHILE cy = 0 DEF SEG = data.seg f.name$ = "" i = data.off + 30 WHILE PEEK(i) <> 0 f.name$ = f.name$ + CHR$(PEEK(i)) i = i + 1 WEND DEF SEG PRINT f.name$ + " "; inregs.ax = &H4F00 CALL INTERRUPTX(&H21, inregs, outregs) cy = outregs.flags AND 1 WEND ELSE GOSUB PRINTNOCAPFILES END IF PRINT STRING$(75, 196) INPUT "Filename to load"; n$ RETURN PRINTNOCAPFILES: PRINT "There are no .CAP files in this directory." PRINT STRING$(75, 196) INKEY5: i$ = INKEY$: IF i$ = "" THEN GOTO INKEY5 DEF SEG : CLS : SCREEN 0: WIDTH 80: END putcursor: PUT (x - 3, y - 3), d FOR d = 0 TO 50: NEXT PUT (x - 3, y - 3), d RETURN printnewcolor: PAINT (180, 185), c, 142 LOCATE 25, 30 PRINT " "; LOCATE 25, 30 PRINT c; RETURN bloadscrn: CLS DEF SEG = &HA000 BLOAD "temp.bin", 0 RETURN ' Msg #: 1017 QUIKBAS Subboard From: RICH GELDREICH Sent: 04-09-93 22:54 To: QUINN TYLER JACKSON Rcvd: -NO- Re: COMP002C.BAS 1/7 This is a newer version of the compressor. I've greatly improved the documentation of the program, and fixed a few bugs. The decompressor hasn't changed. '_____O_/________________________| SNIP |______________________\_O___ ' O \ | HERE | / O 'This file created by PostIt! v6.0. '>>> Start of page 1. '-------------------------------------------------------------------- 'File name: COMP002C.BAS 'Description: Compresses variable length strings using LZ77 ' based sliding dictionary algorithm. 'Revision: 1.1 'Compiler: At least PDS. 'Author: Rich Geldreich 'Date: April 1993 ' 'Fixes in revision 1.1: ' 1. Found stupid bug in SrgSlideDict routine that cause it to not ' remove strings that slid out of the dictionary. ' 2. Added & rewrote comments so people other than me can understand ' what the hell this thing is doing. :-) ' 3. Renamed internal functions so they were prefixed with "Frg" ' instead of "Fun" like Quinn wanted. ' 4. Shrunk hash table to 1024 linked lists so less memory is used ' and because it didn't seem to increase speed much with most files. '-------------------------------------------------------------------- 'The LZ77 algorithm reduces the size required to store data by 'replacing strings of characters with pointers to previously sent 'strings. The algorithm always tries to find a match for a string; 'if no match can be found a single character of the string is sent 'uncompressed and the search starts over with the next character. 'This is done until no more characters remain to be compressed. In 'theory the algorithm is very simple, but getting an implementation 'of it up to speed is a bit of a challenge. '-------------------------------------------------------------------- 'How this program works: ' 'This program finds matches for upcoming text by organizing thousands 'of linked lists which contain strings which all start with the same 'three characters(due to hashing collisions this is not true all of 'the time, but the searching algorithm ignores these conditions). ' 'For instance, all strings which start with the characters "ABC" 'would be in the same linked list, so finding a match for any string 'beginning with "ABC" is a simple matter of searching through the '"ABC" list and comparing. A pointer to the largest match would then 'sent to the output stream. Since the pointer would require less 'space than the string it replaced, compression would occur. '-------------------------------------------------------------------- DEFINT A-Z CONST Version = 1 CONST True = -1, False = 0 CONST DictSize = 8192 'The ZoneSize constant must evenly divide into the DictSize constant! CONST ZoneSize = 1024 CONST MaxTries = 100 'Affects speed vs. compression. 'The HashSize constant must be a power of two! CONST HashSize = 2048 'Affects speed vs. memory. 'Do not change MinMatch, because the entire program depends on it 'being three. CONST MinMatch = 3 CONST MaxMatch = 266 TYPE BitOutputType ByteOffset AS INTEGER BitOffset AS INTEGER BitBuffer AS LONG END TYPE ' Sliding Dictionary REDIM SHARED Dictionary(0) ' Hash table, each element is the head of its own linked list. ' Each linked lists contains strings which start with the same three ' character sequence. REDIM SHARED HashTable(0) ' Linked list pointers. Each NextString() array element contains either ' -1, which signals that this is the last string in the list, or a ' pointer to another string that hashed to the same value and occured ' before it in dictionary. REDIM SHARED NextString(0) DIM SHARED IsInitialized DIM SHARED PowerOfTwo(0 TO 15) AS LONG 'For fast shifts DIM SHARED OutputString$, OutputInfo AS BitOutputType DIM SHARED BytesToCompress, UnCompressable FUNCTION FrgCompression (InText$) 'Allocate work arrays. REDIM Dictionary(0 TO (DictSize + MaxMatch) - 1) REDIM HashTable(0 TO HashSize - 1) REDIM NextString(0 TO DictSize - 1) SrgLoadHashTable SlidePointer = 0 StringPointer = 1 BytesLeft = BytesToCompress DO UNTIL UnCompressable OR BytesLeft = 0 'Dictionary all filled up? IF SlidePointer = DictSize THEN 'Move dictionary "left" ZoneSize characters so more 'data can be copied into it. SlidePointer = DictSize - ZoneSize SrgSlideDict END IF 'Find how many bytes we can do in this zone. BytesToDo = ZoneSize IF BytesLeft < ZoneSize THEN BytesToDo = BytesLeft 'Enter new characters to compress into hash table and 'linked lists. SrgHash InText$, SlidePointer, StringPointer, BytesToDo 'Compress the data zone. SrgSearch SlidePointer, BytesToDo BytesLeft = BytesLeft - BytesToDo StringPointer = StringPointer + BytesToDo SlidePointer = SlidePointer + ZoneSize LOOP 'If data can't be compressed then just store it. IF UnCompressable THEN MID$(OutputString$, 17) = InText$ OutputInfo.ByteOffset = 17 + BytesToCompress FrgCompression = 0 ELSE 'Flush output buffer. SrgWriteBits 0, 7 FrgCompression = 1 END IF 'Deallocate work arrays. REDIM Dictionary(0) REDIM HashTable(0) REDIM NextString(0) END FUNCTION 'InText$ is the string to compress. The string returned is the 'compressed version of InText$. If ErrorCode is not zero, 'then expect one of the following error codes: ' -1 = String is null. ' -2 = String is too large. FUNCTION FunGeldComp$ (InText$, ErrorCode) FunGeldComp$ = "" ErrorCode = 0 'Initialize power of two table if first time in function. IF IsInitialized = False THEN IsInitialized = True J& = 1 FOR a = 0 TO 15 PowerOfTwo(a) = J& J& = J& * 2 'SHL 1 NEXT END IF BytesToCompress = LEN(InText$) UnCompressable = False 'If no characters to compress, then exit. This may change.. ? IF BytesToCompress = 0 THEN ErrorCode = -1 EXIT FUNCTION 'If more than 32,000 bytes to compress then exit with error 'because an out of string space error will probably occur. ELSEIF BytesToCompress > 32000 THEN ErrorCode = -2 EXIT FUNCTION END IF 'Initialize output string. OutputString$ = SPACE$(128 + BytesToCompress) 'Initialize bit output structure. OutputInfo.ByteOffset = 17 OutputInfo.BitOffset = 0 OutputInfo.BitBuffer = 0 'Write string header. MID$(OutputString$, 1) = "REN" '1-3 MID$(OutputString$, 4) = CHR$(Version) '4-4 MID$(OutputString$, 5) = MKI$(BytesToCompress) '5-6 'Attempt to compress the string. Algorithm = FrgCompression(InText$) 'Store number of bytes stored or compressed and algorithm into 'string header. MID$(OutputString$, 7) = MKI$(OutputInfo.ByteOffset - 17)'7-8 MID$(OutputString$, 9) = CHR$(Algorithm) FunGeldComp$ = LEFT$(OutputString$, OutputInfo.ByteOffset) 'Deallocate global work string for efficiency. OutputString$ = "" END FUNCTION SUB SrgChar (BYVAL Char) 'Output one bit as a flag and an unencoded character to the ' output 'string. SrgWriteBits Char * 2, 9 END SUB SUB SrgHash (InText$, BYVAL SlidePointer, BYVAL StringPointer,_ BYVAL TotalBytes) 'Copy the new characters from the input string into dictionary. J = SlidePointer FOR a = StringPointer TO StringPointer + TotalBytes - 1 Dictionary(J) = ASC(MID$(InText$, a, 1)) J = J + 1 NEXT 'Enter characters into hash table. Each three character sequence in 'the dictionary is hashed and placed at the head of the linked list 'which contains the strings which start with those same three 'characters. 'This ensures that each linked list is always sorted by age, where 'the oldest strings (the least important strings) are near the end 'of the linked list and the youngest strings are near the head of 'the list. 'After hashing, compressing the data is a simple matter of running 'down a string's linked list and comparing to find the largest match. 'Initialize the hash accumulator. hash = (Dictionary(SlidePointer) * 32 XOR Dictionary(SlidePointer + 1)) FOR a = SlidePointer TO (SlidePointer + TotalBytes - 1) - 2 'Shift left hash accumulator five places and XOR it with the next 'character. 'The accumulator is shifted left five places so only the last 'three characters are used in the hash(5*3=15 bits). hash = (((hash AND 1023) * 32) XOR Dictionary(a + 2)) AND (HashSize - 1) J = a 'Make the new string the head of its linked list. SWAP HashTable(hash), J 'Make hash table entry point to new string. NextString(a) = J 'Make new string point to old string. NEXT 'Set the last two strings which weren't hashed in the above loop 'to null, because they are at the end of the zone where there aren't 'enough characters to find a match over the two character threshold of 'this program. (One thing to note: this algorithm cannot find 'matches between zone boundries.) FOR a = (SlidePointer + TotalBytes - 1) - 1 TO (SlidePointer + TotalBytes - 1) 'Don't access negative array elements, this may happen when 'the amount of characters in the zone is very small. IF a >= 0 THEN NextString(a) = -1 NEXT END SUB SUB SrgLoadHashTable 'Initialize all elements in hash table to null. FOR a = 0 ╧ HashSize - 1 HashTable(a) = -1 NEXT END SUB SUB SrgMatch (BYVAL MatchPos, BYVAL MatchLen) 'This output system could be improved greatly! SrgWriteBits 1, 1 a = MatchLen - MinMatch IF a <= 7 THEN SrgWriteBits 0, 1 SrgWriteBits a, 3 ELSE SrgWriteBits 1, 1 a = a - 8 IF a <= 31 THEN SrgWriteBits 0, 1 SrgWriteBits a, 5 ELSE SrgWriteBits 1, 1 SrgWriteBits a, 8 END IF END IF 'Favor closer matches which occur more often than far matches. IF MatchPos <= 511 THEN SrgWriteBits 0, 1 SrgWriteBits MatchPos, 9 ELSE SrgWriteBits 1, 1 SrgWriteBits MatchPos, 13 END IF END SUB SUB SrgScan (BYVAL SlidePos, MatchPos, MatchLen) STATIC 'This subroutine finds the longest & closest match in the dictionary 'for the string at position SlidePos. 'Only the strings which occured before the string at SlidePos are 'compared, because the decompressor already has these strings in 'its dictionary. Also, only the strings which hash to the same 'value are compared against the string at SlidePos. Finding these 'strings is very simple because they are always stored in the 'same linked list as the string at SlidePos is in. 'Mimick a current match length to two characters. MatchLen = 2 'To eliminate worthless compares that do not exceed our best 'match found so far one character of the compare string is tested 'against our search string. This character's position is based 'on the best match length found so far. If this character matches, 'a normal string compare is performed. If it doesn't, the compare is 'skipped because the compare string could not possibly match our 'search string enough to exceed the best match found so far. This 'greatly speeds up the search for the best match because it 'eliminates many string compares. MatchChar = Dictionary(SlidePos + MatchLen) 'Access linked list to find closest string which hashed to the 'same value. ComparePos = NextString(SlidePos) FOR a = 1 TO MaxTries 'Have we hit the end of the list? IF ComparePos = -1 THEN EXIT FOR 'Only do the compare if the string can exceed our best match 'length so far. This saves time because it eliminates futile 'compares. IF Dictionary(ComparePos + MatchLen) = MatchChar THEN 'Compare the two strings. FOR CompareLen = 0 TO MaxMatch - 1 IF Dictionary(ComparePos + CompareLen) <> Dictionary(SlidePos + CompareLen) THEN EXIT FOR NEXT 'If match is larger than current match then make it our 'current match. IF CompareLen > MatchLen THEN MatchLen = CompareLen MatchPos = ComparePos 'If match length = maximum match length then stop 'searching because we cannot find any match which 'is larger. IF MatchLen = MaxMatch THEN EXIT SUB 'Get new must match character because the match length 'was changed. MatchChar = Dictionary(SlidePos + MatchLen) END IF END IF 'Fetch next string which hashed to the same value. ComparePos = NextString(ComparePos) NEXT 'If match length didn't change from what it was set to at the 'beginning of the search, then set it equal to one character. 'This is used as a flag to indicate that no match could be 'found for the search string. MatchLen = MatchLen + (MatchLen = 2) END SUB SUB SrgSearch (BYVAL SlidePointer, BYVAL TotalBytes) 'This subroutine replaces upcoming data with pointers to 'previously sent data. DO UNTIL TotalBytes = 0 OR UnCompressable SrgScan SlidePointer, MatchPos1, MatchLen1 'Add this code to increase compression, but decrease speed: IF (MatchLen1 >= MinMatch) AND (MatchLen1 < 64) THEN 'Check match one character ahead and eliminate current 'match if it is larger. SrgScan SlidePointer + 1, MatchPos2, MatchLen2 IF MatchLen2 > MatchLen1 THEN SrgChar Dictionary(SlidePointer) SlidePointer = SlidePointer + 1 TotalBytes = TotalBytes - 1 IF TotalBytes = 0 THEN EXIT DO MatchLen1 = MatchLen2 MatchPos1 = MatchPos2 END IF END IF 'If no match found or not enough characters left in zone 'for a match then just output one character. IF (MatchLen1 < MinMatch) OR (TotalBytes < MinMatch) THEN SrgChar Dictionary(SlidePointer) ELSE 'Limit match length if too long. IF MatchLen1 > TotalBytes THEN MatchLen1 = TotalBytes 'Send match pointer and length to output string. SrgMatch SlidePointer - MatchPos1, MatchLen1 END IF TotalBytes = TotalBytes - MatchLen1 SlidePointer = SlidePointer + MatchLen1 LOOP END SUB 'This subroutine slides the dictionary left ZoneSize characters and 'updates the hash table and linked lists. SUB SrgSlideDict 'Slide dictionary. FOR a = ZoneSize TO DictSize - 1 Dictionary(a - ZoneSize) = Dictionary(a) NEXT 'Slide linked list cells. Set any cell which points to a string 'just slid out of dictionary to -1. FOR a = ZoneSize TO DictSize - 1 B = NextString(a) - ZoneSize 'If B < 0, then set cell to -1, or null because it points to a 'deleted string which just slide out. NextString(a - ZoneSize) = B OR (B < 0) NEXT 'Update hash table so it points to the correct strings. FOR a = 0 TO HashSize - 1 B = HashTable(a) - ZoneSize HashTable(a) = B OR (B < 0) NEXT END SUB SUB SrgWriteBits (BYVAL bits, BYVAL NumBits) 'This subroutine writes variable length codes to the output 'string. 'Add bits to bit buffer. OutputInfo.BitBuffer = OutputInfo.BitBuffer OR (bits *_ PowerOfTwo(OutputInfo.BitOffset)) 'NumBits more bits in buffer now. OutputInfo.BitOffset = OutputInfo.BitOffset + NumBits 'At least one byte in bit buffer? DO WHILE OutputInfo.BitOffset > 7 'Write byte to output string. MID$(OutputString$, OutputInfo.ByteOffset, 1) =_ CHR$(OutputInfo.BitBuffer AND 255) OutputInfo.ByteOffset = OutputInfo.ByteOffset + 1 'Get rid of byte just written by shifting the buffer right 8 'times. OutputInfo.BitBuffer = OutputInfo.BitBuffer \ 256 'SHR 8 '8 less bits now. OutputInfo.BitOffset = OutputInfo.BitOffset - 8 'Check to see if the output position passed the original 'string's size. IF OutputInfo.ByteOffset >= (BytesToCompress - 16) THEN UnCompressable = True '!Stop compressing string. EXIT SUB END IF LOOP END SUB ' That's it! I really feel very embarrased about posting the first 'version, because I didn't spend too much time on the remarks, spelling, 'and grammer. Maby I jumped the gun and posted it too early. ' ' The next revision will contain a much better coding system for 'greater compression and will implement the special handling of different 'types of data. It will also use a recursive searching algorithm that 'will increase compression on text by 5% or so. ' ' Msg #: 1073 QUIKBAS Subboard From: QUINN TYLER JACKSON Sent: 04-10-93 00:00 To: RICH GELDREICH Rcvd: -NO- Re: COMP002T.BAS RICH This testing routine has been modified to fit the revised calling syntax of the compression function. DEFINT A-Z DECLARE FUNCTION funGeldComp$ (InText$, TextType, OptimizeType,ErrorCode%) DECLARE FUNCTION funGeldDecomp$ (InString$, ErrorCode%) CLS RANDOMIZE TIMER A$ = "c:\dos\wp\fic\" + DIR$("c:\dos\wp\fic\*.txt") DO UNTIL A$ = "" K = 10000 'K = RND * 10000 + 10 OPEN A$ FOR BINARY AS #1 IF LOF(1) < K THEN K = LOF(1) UnCompressed$ = SPACE$(K) GET #1, , UnCompressed$ CLOSE #1 IF LEN(UnCompressed$) = 0 THEN PRINT "Null" ELSE PRINT "C "; LEN(UnCompressed$); "bytes... "; Start! = TIMER TextType = 1 'Text OptType = 1 ' For size Compressed$ = funGeldComp$(UnCompressed$, TextType, OptType, ErrorCode) PRINT LEN(Compressed$); TIMER - Start!; IF ErrorCode THEN PRINT ErrorCode END END IF PRINT "D "; Start! = TIMER Decompressed$ = funGeldDecomp$(Compressed$, ErrorCode) PRINT TIMER - Start! IF ErrorCode THEN PRINT ErrorCode END END IF IF Decompressed$ <> UnCompressed$ THEN STOP END IF PRINT UnCompressed$ = "" Compressed$ = "" Decompressed$ = "" A$ = "c:\dos\wp\fic\" + DIR$ IF INKEY$ <> "" THEN END LOOP DECLARE FUNCTION FunQompress$ (St$) DECLARE FUNCTION funGeldComp$ (InText$, TextType%, OptimizeType%, ErrorCode%) DECLARE SUB srgChar (BYVAL Char%) DECLARE SUB srgHash (InText$, BYVAL SlidePointer%, BYVAL StringPointer%, BYVAL TotalBytes%) DECLARE SUB srgLoadHashTable () DECLARE SUB srgMatch (BYVAL MatchPos%, BYVAL MatchLen%) DECLARE SUB srgScan (BYVAL SlidePos%, MatchPos%, MatchLen%) DECLARE SUB srgSearch (BYVAL SlidePointer%, BYVAL TotalBytes%) DECLARE SUB srgSlideDict () DECLARE SUB srgWriteBits (BYVAL Bits%, BYVAL NumBits%) DECLARE FUNCTION frgCompression% (InText$) '[Comments taken out for this working revision to conserve badwidth.] DEFINT A-Z CONST VERSION = 1 CONST TRUE = -1 FALSE = NOT TRUE CONST DictSize = 8192 'The ZoneSize constant must evenly divide into the DictSize constant! CONST ZoneSize = 2048 'Do not change MinMatch, because the entire program depends on it 'being three. CONST MinMatch = 3 CONST MaxMatch = 266 TYPE BitOutputType ByteOffset AS INTEGER BitOffset AS INTEGER BitBuffer AS LONG END TYPE ' Error constants ' These added by QTJ for clarity CONST ErrRGCNoInString = -1 CONST ErrRGCLongInString = -2 CONST ErrRGCBadHeader = -3 CONST ErrRGCBadStrLength = -4 CONST ErrRGCBadAlgoritmFlag = -5 CONST ErrRGCBadVersion = -6 ' Sliding Dictionary REDIM SHARED Dictionary(0) ' Hash table, each element is the "head" of its own linked list. ' Each linked lists contains strings which start with the same three ' character sequence. (Hashing collisions of course prevent this from ' being true all of the time.) REDIM SHARED HashTable(0) ' Linked list pointers. Each element points to another element before ' it in the dictionary, or contains -1 which signals the end of the ' linked ' list. To search for a match for any element in the dictionary, simply ' look up its next string and compare it. Keep on doing this until ' we find the largest match, the end of the linked list, or until we ' exaust our allowed number of searches (defined by the constant ' MaxTries). REDIM SHARED NextString(0) DIM SHARED IsInitialized DIM SHARED PowerOfTwo(0 TO 15) AS LONG DIM SHARED OutputString$, OutputInfo AS BitOutputType DIM SHARED BytesToCompress, UnCompressable DIM SHARED MaxTries DIM SHARED HashSize DIM SHARED OptType FUNCTION frgCompression (InText$) REDIM Dictionary(0 TO (DictSize + MaxMatch) - 1) REDIM HashTable(0 TO HashSize - 1) REDIM NextString(0 TO DictSize - 1) FOR A = 0 TO HashSize - 1 HashTable(A) = -1 NEXT SlidePointer = 0 StringPointer = 1 BytesLeft = BytesToCompress DO UNTIL UnCompressable OR BytesLeft = 0 'Dictionary all filled up? IF SlidePointer = DictSize THEN SlidePointer = DictSize - ZoneSize 'Move dictionary "left" so more characters can be 'thrown into it. srgSlideDict END IF 'Find how many bytes we can do in this zone... BytesToDo = ZoneSize IF BytesLeft < ZoneSize THEN BytesToDo = BytesLeft END IF 'Enter new characters to compress into search structures. srgHash InText$, SlidePointer, StringPointer, BytesToDo 'Find matches for the characters. srgSearch SlidePointer, BytesToDo BytesLeft = BytesLeft - BytesToDo StringPointer = StringPointer + BytesToDo SlidePointer = SlidePointer + ZoneSize LOOP 'If data can't be compressed then just store it. IF UnCompressable THEN MID$(OutputString$, 17) = InText$ OutputInfo.ByteOffset = 17 + BytesToCompress frgCompression = 0 ELSE 'Flush output buffer. srgWriteBits 0, 8 frgCompression = 1 END IF 'REDIM Dictionary(0) 'REDIM HashTable(0) 'REDIM NextString(0) END FUNCTION FUNCTION funGeldComp$ (InText$, TextType, OptimizeType, ErrorCode) OptType = OptimizeType IF TextType = 0 THEN TextType = 1 END IF funGeldComp$ = "" ErrorCode = ErrRGCNoError IF NOT IsInitialized THEN IsInitialized = TRUE J& = 1 FOR A = 0 TO 15 PowerOfTwo(A) = J& J& = J& * 2 NEXT END IF BytesToCompress = LEN(InText$) UnCompressable = FALSE SELECT CASE BytesToCompress CASE 0 ErrorCode = ErrRGCNoInString EXIT FUNCTION CASE IS > 32000 ErrorCode = ErrRGCLongInString EXIT FUNCTION END SELECT ' This table added by QTJ to meet COMP002.ASN specs regarding ' optimization and TextType parameters. These are only a few of ' the possible variables that can be tweaked to alter algorithm's ' performance according to text and optimizaton types. The best part ' of this method is that the same decmopression algorithm works for ' all variations. Some distinctions are really quite minimal, but ' I plan on tweaking this further, later. SELECT CASE TextType + (10 * OptimizeType) CASE 1 ' Text for speed MaxTries = 1 HashSize = 2048 * 2 CASE 2 ' Foreign for speed MaxTries = 1 HashSize = 2048 CASE 3 ' Random for speed MaxTries = 1 HashSize = 2048 CASE 11 ' Text for size MaxTries = 1000 HashSize = 2048 * 4 CASE 12 ' Foreign for size MaxTries = 1000 HashSize = 2048 CASE 13 ' Random for size MaxTries = 100 HashSize = 2048 * 4 END SELECT OutputString$ = SPACE$(128 + BytesToCompress) OutputInfo.ByteOffset = 17 OutputInfo.BitOffset = 0 OutputInfo.BitBuffer = 0 MID$(OutputString$, 1) = "RGC" '1-3 MID$(OutputString$, 4) = CHR$(VERSION) '4-4 MID$(OutputString$, 5) = MKI$(BytesToCompress) '5-6 Algorithm = frgCompression(InText$) MID$(OutputString$, 7) = MKI$(OutputInfo.ByteOffset - 17)'7-8 MID$(OutputString$, 9) = CHR$(Algorithm) funGeldComp$ = LEFT$(OutputString$, OutputInfo.ByteOffset) OutputString$ = "" END FUNCTION SUB srgHash (InText$, BYVAL SlidePointer, BYVAL StringPointer, BYVAL TotalBytes) 'Copy characters from input string into dictionary. J = SlidePointer FOR A = StringPointer TO StringPointer + TotalBytes - 1 Dictionary(J) = ASC(MID$(InText$, A, 1)) J = J + 1 NEXT 'Enter characters into hash table. Each three character sequence in 'the dictionary is hashed and placed at the head of its linked list. 'This ensures that each linked list is always sorted by 'age, where the oldest strings (the least important strings) are near 'the end of the linked list and the youngest strings are near the 'head of the list. After hashing, compressing the data is a simple 'matter of running down a string's linked list and comparing to find 'the largest match. 'Initialize the hash accumulator. Hash = (Dictionary(SlidePointer) * 32 XOR Dictionary(SlidePointer + 1)) FOR A = SlidePointer TO (SlidePointer + TotalBytes - 1) - 2 'Shift left hash accumulator 5 places and XOR it with 'the next character. Hash = (((Hash AND 1023) * 32) XOR Dictionary(A + 2)) AND (HashSize - 1) J = A 'Make the new string the "head" of its linked list. 'Make hash table entry point to new string. SWAP HashTable(Hash), J 'Make new string point to old string. NextString(A) = J NEXT 'Set the last two strings which weren't hashed in the above loop 'to -1. FOR A = (SlidePointer + TotalBytes - 1) - 1 TO (SlidePointer + TotalBytes - 1) IF A >= 0 THEN NextString(A) = -1 END IF NEXT END SUB SUB srgMatch (BYVAL MatchPos, BYVAL MatchLen) 'This output system could be improved greatly! srgWriteBits 1, 1 A = MatchLen - MinMatch srgWriteBits MatchPos, 9 ELSE srgWriteBits 1, 1 srgWriteBits MatchPos, 13 END IF END SUB SUB srgScan (BYVAL SlidePos, MatchPos, MatchLen) ' THIS IS TO BE WRITTEN IN MASM! 'This subroutine finds a match for the string at position SlidePos. MatchLen = 2 MatchChar = Dictionary(SlidePos + MatchLen) ComparePos = NextString(SlidePos) FOR A = 1 TO MaxTries IF ComparePos = -1 THEN EXIT FOR END IF 'Only do the compare if the character at the current match length 'matches. IF Dictionary(ComparePos + MatchLen) = MatchChar THEN FOR SearchLen = 0 TO MaxMatch - 1 IF Dictionary(ComparePos + SearchLen) <> Dictionary(SlidePos + SearchLen) THEN EXIT FOR END IF NEXT IF SearchLen > MatchLen THEN MatchLen = SearchLen MatchPos = ComparePos IF MatchLen = MaxMatch THEN EXIT SUB END IF MatchChar = Dictionary(SlidePos + MatchLen) END IF END IF ComparePos = NextString(ComparePos) NEXT MatchLen = MatchLen + (MatchLen = 2) END SUB SUB srgSearch (BYVAL SlidePointer, BYVAL TotalBytes) DO UNTIL TotalBytes = 0 OR UnCompressable srgScan SlidePointer, MatchPos1, MatchLen1 IF OptType THEN ' optimize for size at the cost of speed IF (MatchLen1 >= MinMatch) AND (MatchLen1 < 64) THEN srgScan SlidePointer + 1, MatchPos2, MatchLen2 IF MatchLen2 > MatchLen1 THEN srgWriteBits Dictionary(SlidePointer) * 2, 9 SlidePointer = SlidePointer + 1 TotalBytes = TotalBytes - 1 IF TotalBytes = 0 THEN EXIT DO END IF MatchLen1 = MatchLen2 MatchPos1 = MatchPos2 END IF END IF END IF IF (MatchLen1 < MinMatch) OR (TotalBytes < MinMatch) THEN srgWriteBits Dictionary(SlidePointer) * 2, 9 ELSE IF MatchLen1 > TotalBytes THEN MatchLen1 = TotalBytes END IF srgMatch SlidePointer - MatchPos1, MatchLen1 END IF TotalBytes = TotalBytes - MatchLen1 SlidePointer = SlidePointer + MatchLen1 LOOP END SUB 'This subroutine slides the dictionary down ZoneSize characters and 'updates the hash table and linked lists. SUB srgSlideDict () 'Slide dictionary. FOR A = ZoneSize TO DictSize - 1 Dictionary(A - ZoneSize) = Dictionary(A) NEXT 'Slide linked list cells. Set any cell which points to a string 'just slid out to -1. FOR A = ZoneSize TO DictSize - 1 B = NextString(A) - ZoneSize 'If B < 0, then set cell to -1, or null. NextString(A - ZoneSize) = B OR (B < 0) NEXT 'Update hash table so it points to the correct strings. FOR A = 0 TO HashSize - 1 B = HashTable(A) - ZoneSize HashTable(A) = B OR (B < 0) NEXT END SUB SUB srgWriteBits (BYVAL Bits, BYVAL NumBits) 'THIS IS TO BE WRITTEN IN MASM! OutputInfo.BitBuffer = OutputInfo.BitBuffer OR (Bits * PowerOfTwo(OutputInfo.BitOffset)) OutputInfo.BitOffset = OutputInfo.BitOffset + NumBits DO WHILE OutputInfo.BitOffset > 7 MID$(OutputString$, OutputInfo.ByteOffset, 1) = CHR$(OutputInfo.BitBuffer AND 255) OutputInfo.ByteOffset = OutputInfo.ByteOffset + 1 OutputInfo.BitBuffer = OutputInfo.BitBuffer \ 256 'SHR 8 OutputInfo.BitOffset = OutputInfo.BitOffset - 8 IF OutputInfo.ByteOffset >= (BytesToCompress - 16) THEN UnCompressable = TRUE EXIT SUB END IF LOOP END SUB From: QUINN TYLER JACKSON Sent: 04-09-93 23:59 To: RICH GELDREICH Rcvd: -NO- Re: COMP002D.BAS 1/ ' COMP002D.BAS Written by Rich Geldreich for QBCIMR BBS Project ' Tweaked by Quinn Tyler Jackson for speed and size. DECLARE FUNCTION funGeldDecomp$ (InString$, ErrorCode%) DECLARE FUNCTION frgGetBit% (InString$) DECLARE FUNCTION frgGetBits% (BYVAL NumBits%, InString$) DECLARE FUNCTION frgGetMatchLen% (InString$) DECLARE FUNCTION frgGetMatchPos% (InString$) DEFINT A-Z CONST VERSION = 1 CONST TRUE = -1 FALSE = 0 CONST DictSize = 8192 CONST MinMatch = 3 ' Error constants added by QTJ for clarity CONST ErrRGCNoInString = -1 CONST ErrRGCLongInString = -2 CONST ErrRGCBadHeader = -3 CONST ErrRGCBadStrLength = -4 CONST ErrRGCBadAlgoritmFlag = -5 CONST ErrRGCBadVersion = -6 TYPE BitInputType ByteOffset AS INTEGER BitOffset AS INTEGER BitBuffer AS LONG END TYPE DIM SHARED IsInitialized DIM SHARED PowerOfTwo(0 TO 15) AS LONG DIM SHARED InputInfo AS BitInputType FUNCTION frgGetBit (InString$) ' THIS IS TO BE WRITTEN IN MASM! IF InputInfo.BitOffset = 0 THEN InputInfo.BitBuffer = ASC(MID$(InString$,InputInfo.ByteOffset, 1)) InputInfo.ByteOffset = InputInfo.ByteOffset + 1 InputInfo.BitOffset = 8 END IF frgGetBit = InputInfo.BitBuffer AND 1 InputInfo.BitBuffer = InputInfo.BitBuffer \ 2 InputInfo.BitOffset = InputInfo.BitOffset - 1 END FUNCTION FUNCTION frgGetBits (BYVAL NumBits, InString$) ' THIS IS TO BE WRITTEN IN MASM! DO WHILE NumBits > InputInfo.BitOffset InputInfo.BitBuffer = InputInfo.BitBuffer OR ASC(MID$(InString$, InputInfo.ByteOffset, 1)) * PowerOfTwo(InputInfo.BitOffset) InputInfo.ByteOffset = InputInfo.ByteOffset + 1 InputInfo.BitOffset = InputInfo.BitOffset + 8 LOOP K = PowerOfTwo(NumBits) frgGetBits = InputInfo.BitBuffer AND (K - 1) InputInfo.BitBuffer = InputInfo.BitBuffer \ K InputInfo.BitOffset = InputInfo.BitOffset - NumBits END FUNCTION FUNCTION funGeldDecomp$ (InString$, ErrorCode) funGeldDecomp$ = "" ErrorCode = ErrRGCNoError IF LEN(InString$) <= 16 OR LEFT$(InString$, 3) <> "RGC" THEN ErrorCode = ErrRGCBadHeader EXIT FUNCTION ELSE ' This is a version compatability table. As versions progress, ' those that are compatible will be added to the first case. ' All other versions will exit with an ErrRGCBadVersion error. ' This allows for revisions that maintain compatibility with strings ' compressed by previous versions, while also catching those strings ' that are no longer compatible with the decompressor. Added by ' QTJ. SELECT CASE ASC(MID$(InString$, 4, 2)) CASE 1 ' All compatible revision numbers added here ' Do nothing! CASE ELSE ' This covers non-compatible revisions as time passes ErrorCode = ErrRGCBadVersionNum EXIT FUNCTION END SELECT END IF IF NOT IsInitialized THEN IsInitialized = TRUE J& = 1 FOR A = 0 TO 15 PowerOfTwo(A) = J& J& = J& * 2 NEXT END IF BytesToDecompress = CVI(MID$(InString$, 5, 2)) BytesCompressed = CVI(MID$(InString$, 7, 2)) Algorithm = ASC(MID$(InString$, 9, 1)) IF (LEN(InString$) - 16) < BytesCompressed THEN ErrorCode = ErrRGCBadStrLength EXIT FUNCTION END IF SELECT CASE Algorithm CASE 0 funGeldDecomp$ = MID$(InString$, 17, BytesToDecompress) CASE 1 OutputString$ = SPACE$(BytesToDecompress) OutputOffset = 1 InputInfo.ByteOffset = 17 InputInfo.BitBuffer = 0 InputInfo.BitOffset = 0 DO UNTIL OutputOffset > BytesToDecompress IF frgGetBit(InString$) THEN ' Brought in-line to reduce calling overhead: QTJ IF frgGetBit(InString$) THEN IF frgGetBit(InString$) THEN MatchLen = MinMatch + 8 + frgGetBits(8, InString$) ELSE MatchLen = MinMatch + 8 + frgGetBits(5, InString$) END IF ELSE MatchLen = MinMatch + frgGetBits(3, InString$) END IF ' Brought in-line to reduce calling overhead: QTJ IF frgGetBit(InString$) THEN MatchPos = frgGetBits(13, InString$) ELSE MatchPos = frgGetBits(9, InString$) END IF IF MatchPos <= MatchLen THEN MatchPos = OutputOffset - MatchPos FOR J = 0 TO MatchLen - 1 MID$(OutputString$, OutputOffset + J) = MID$(OutputString$, MatchPos + J, 1) NEXT ELSE MatchPos = OutputOffset - MatchPos MID$(OutputString$, OutputOffset) = MID$(OutputString$, MatchPos, MatchLen) END IF OutputOffset = OutputOffset + MatchLen ELSE MID$(OutputString$, OutputOffset) = CHR$(frgGetBits(8, InString$)) OutputOffset = OutputOffset + 1 END IF LOOP IF OutputOffset <> (BytesToDecompress + 1) THEN ErrorCode = ErrRGCBadStrLength ELSE funGeldDecomp$ = OutputString$ END IF OutputString$ = "" CASE ELSE ErrorCode = ErrRGCBadAlgorithmFlag END SELECT END FUNCTION '